From c7a0d0d9af7f83d5d7c1cdaf4e82a3efbf87917c Mon Sep 17 00:00:00 2001 From: Reuben Brooks Date: Sat, 20 Jun 2026 00:07:45 -0500 Subject: [PATCH 1/7] Add shenffi: C-ABI Swift/iOS bindings + tree-shaken shen-cas demo New crate crates/shenffi (staticlib + cdylib) embedding shen-rust behind a small C ABI so it links into Swift/iOS apps. The default shen-rust build has no JIT, so nothing relies on runtime codegen (App Store-safe). Surface: - shen_boot / shen_boot_embedded (FS-free; kernel via include_str!) / shen_boot_shaken (any Ratatoskr-shaken kernel+program slice) / shen_eval / shen_string_free / shen_free. - shen-cas embedded: a Ratatoskr-shaken computer algebra system (298 KB kernel slice + 221 KB CAS KL) with shen_cas_boot / shen_cas_reduce, e.g. "D[Sin[x],x]" -> "[Cos x]". Also: Swift wrapper (swift/ShenRust.swift), C header (include/shenffi.h), XCFramework build script, README. Verified the Swift->Rust->Shen round-trip on macOS and cross-compilation for aarch64-apple-ios (device + simulator). Workspace member added; Cargo.lock updated. Co-Authored-By: Claude Opus 4.8 --- Cargo.lock | 7 + Cargo.toml | 1 + crates/shenffi/Cargo.toml | 15 + crates/shenffi/README.md | 99 ++ crates/shenffi/build-xcframework.sh | 23 + crates/shenffi/cas/cas-all.kl | 1943 +++++++++++++++++++++++++++ crates/shenffi/cas/cas-kernel.kl | 1272 ++++++++++++++++++ crates/shenffi/include/shenffi.h | 50 + crates/shenffi/src/lib.rs | 325 +++++ crates/shenffi/swift/ShenRust.swift | 35 + crates/shenffi/swift/cas-demo.swift | 34 + crates/shenffi/swift/main.swift | 25 + 12 files changed, 3829 insertions(+) create mode 100644 crates/shenffi/Cargo.toml create mode 100644 crates/shenffi/README.md create mode 100755 crates/shenffi/build-xcframework.sh create mode 100644 crates/shenffi/cas/cas-all.kl create mode 100644 crates/shenffi/cas/cas-kernel.kl create mode 100644 crates/shenffi/include/shenffi.h create mode 100644 crates/shenffi/src/lib.rs create mode 100644 crates/shenffi/swift/ShenRust.swift create mode 100644 crates/shenffi/swift/cas-demo.swift create mode 100644 crates/shenffi/swift/main.swift diff --git a/Cargo.lock b/Cargo.lock index e4d6f42..2aeda5b 100644 --- a/Cargo.lock +++ b/Cargo.lock @@ -1321,6 +1321,13 @@ dependencies = [ "shen-rust", ] +[[package]] +name = "shenffi" +version = "0.1.0" +dependencies = [ + "shen-rust", +] + [[package]] name = "shengen-rust" version = "0.1.0" diff --git a/Cargo.toml b/Cargo.toml index 788779b..2085a18 100644 --- a/Cargo.toml +++ b/Cargo.toml @@ -5,6 +5,7 @@ members = [ "crates/shengen-rust", "crates/klcompile", "crates/ratatoskr-build", + "crates/shenffi", "bin/shen-rust", "examples/shen-cedar-authz", ] diff --git a/crates/shenffi/Cargo.toml b/crates/shenffi/Cargo.toml new file mode 100644 index 0000000..78462dd --- /dev/null +++ b/crates/shenffi/Cargo.toml @@ -0,0 +1,15 @@ +[package] +name = "shenffi" +version.workspace = true +edition.workspace = true + +# A thin C-ABI surface over shen-rust, so the interpreter can be embedded in +# non-Rust hosts (Swift / iOS, etc.) as a static library or framework. +# - staticlib -> libshenffi.a (link into an Xcode app / .xcframework) +# - cdylib -> libshenffi.dylib (handy for desktop linking / testing) +[lib] +name = "shenffi" +crate-type = ["staticlib", "cdylib", "rlib"] + +[dependencies] +shen-rust = { path = "../shen-rust" } diff --git a/crates/shenffi/README.md b/crates/shenffi/README.md new file mode 100644 index 0000000..51588de --- /dev/null +++ b/crates/shenffi/README.md @@ -0,0 +1,99 @@ +# shenffi — Swift / C bindings for shen-rust + +A thin C-ABI wrapper that embeds the [shen-rust](../shen-rust) interpreter in +non-Rust hosts — primarily **Swift on iOS/macOS**. shen-rust runs the Shen +kernel via AOT-compiled native code + a bytecode VM (no JIT in the default +build), so it's App Store-safe: it links into your app as a static library, no +runtime codegen. + +## The C surface (`include/shenffi.h`) + +```c +ShenCtx *shen_boot(const char *kernel_dir); // NULL -> auto-locate kernel +char *shen_eval(ShenCtx *ctx, const char *src); // -> rendered result / "error: …" +void shen_string_free(char *s); +void shen_free(ShenCtx *ctx); +``` + +`shen_eval` runs a **Shen-level** expression through the kernel's own pipeline +(`read-from-string` → `head` → `eval`) and renders the result with `shen.app`, +so output matches the REPL. + +## Swift wrapper (`swift/ShenRust.swift`) + +```swift +let shen = try ShenRust(kernelDir: bundleKernelPath) // nil to auto-locate +print(shen.eval("(map (/. X (* X X)) [1 2 3 4])")) // -> [1 4 9 16] +``` + +## Build + +**macOS (desktop / quick test):** +```sh +cargo build --release -p shenffi # -> target/release/libshenffi.{a,dylib} +# round-trip demo: +cd crates/shenffi +swiftc -O -import-objc-header include/shenffi.h swift/ShenRust.swift swift/main.swift \ + -L ../../target/release -lshenffi -o /tmp/shenrust_demo +DYLD_LIBRARY_PATH=../../target/release /tmp/shenrust_demo +``` + +**iOS (device + simulator XCFramework):** +```sh +crates/shenffi/build-xcframework.sh # -> target/ShenRust.xcframework +``` +Then in Xcode: add `ShenRust.xcframework`, set `shenffi.h` as the bridging +header (or wrap in a module map), and drop in `swift/ShenRust.swift`. + +## Kernel on iOS + +`shen_boot(NULL)` auto-locates the kernel by walking the filesystem — fine on +desktop, not on a sandboxed device. Two device-friendly options: + +1. **Bundle the `.kl` kernel** as an app resource and pass its directory path to + `shen_boot(path)`. +2. **Embed a shaken `kernel.kl`** (produced by [ratatoskr](../../ratatoskr)) and + boot from the in-memory source via shen-rust's `boot_from_kl_source` — no + filesystem dependency. (Exposing that through the C ABI is a small addition; + the current `shen_boot` takes a directory path.) + +## Embedding a tree-shaken Shen program (shen-cas) + +The `cas/` directory holds a worked example: the **shen-cas computer algebra +system**, tree-shaken by [ratatoskr](../../ratatoskr) and embedded in the binary. + +Pipeline: +1. Flatten shen-cas's modules into one `.shen` (strip its `(load …)` directives). +2. `ratatoskr shake cas-all.shen out/` → `kernel.kl` (only the kernel functions + the CAS reaches — 298 KB vs the 749 KB full kernel) + `cas-all.kl`. +3. `include_str!` both into the crate; `shen_cas_boot` boots the slice via + `boot_from_kl_source` (kernel + `shen.initialise`) then loads the CAS program. +4. `shen_cas_reduce` calls the CAS's own `parse-expr-string → reduce → + pretty-expr` — no Shen-level `eval` required, so eval-stripping is fine. + +```c +ShenCtx *shen_cas_boot(void); +char *shen_cas_reduce(ShenCtx *ctx, const char *expr); // "D[Sin[x],x]" -> "[Cos x]" +``` + +Verified Swift → Rust → CAS results (`swift/cas-demo.swift`): + +``` +D[Sin[x],x] => [Cos x] +D[x^3,x] => [Times [Power x 2] 3] +D[Exp[x],x] => [Exp x] +6/4 => [3 / 2] +``` + +> The CAS reducer is deeply recursive and runs tree-walked, so call the FFI from +> a thread with a large stack (the demo uses a 512 MB `Thread`; the shen-rust CLI +> does the same). This is the same reason an app should call Shen off the main +> thread. + +## Status + +Verified: the full shen-rust + shenffi stack **compiles for `aarch64-apple-ios` +and `aarch64-apple-ios-sim`**, packages into an `.xcframework`, and the +Swift→Rust→Shen round-trip runs correctly on macOS. The default shen-rust build +has **no JIT** (the optional Cranelift JIT is off by default), so nothing relies +on runtime code generation. diff --git a/crates/shenffi/build-xcframework.sh b/crates/shenffi/build-xcframework.sh new file mode 100755 index 0000000..c52738d --- /dev/null +++ b/crates/shenffi/build-xcframework.sh @@ -0,0 +1,23 @@ +#!/usr/bin/env bash +# Build ShenRust.xcframework (iOS device + simulator) from the shenffi crate. +# Output: /target/ShenRust.xcframework — drag into an Xcode app, +# add the bridging header (shenffi.h) + ShenRust.swift, and you're done. +set -euo pipefail + +cd "$(dirname "$0")/../.." # workspace root (shen-rust/) +HDRS="crates/shenffi/include" + +for tgt in aarch64-apple-ios aarch64-apple-ios-sim; do + rustup target add "$tgt" >/dev/null 2>&1 || true + echo "building shenffi for $tgt ..." + cargo build --release -p shenffi --target "$tgt" +done + +echo "packaging ShenRust.xcframework ..." +rm -rf target/ShenRust.xcframework +xcodebuild -create-xcframework \ + -library target/aarch64-apple-ios/release/libshenffi.a -headers "$HDRS" \ + -library target/aarch64-apple-ios-sim/release/libshenffi.a -headers "$HDRS" \ + -output target/ShenRust.xcframework + +echo "done -> target/ShenRust.xcframework" diff --git a/crates/shenffi/cas/cas-all.kl b/crates/shenffi/cas/cas-all.kl new file mode 100644 index 0000000..374763c --- /dev/null +++ b/crates/shenffi/cas/cas-all.kl @@ -0,0 +1,1943 @@ +(set *intern-table* ()) + +(defun intern-lookup (V3091 V3092) (assoc V3091 V3092)) + +(defun intern-store (V3093 V3094 V3095) (adjoin (cons V3093 (cons V3094 ())) V3095)) + +(defun portable-atom-string (V3096 V3097) (cn (str V3096) (if (symbol? V3097) (str V3097) (str V3097)))) + +(defun hash-atom (V3098 V3099) (hash (portable-atom-string V3098 V3099) 1000000007)) + +(defun hash-compound-args (V3100) (cond ((= () V3100) "") ((cons? V3100) (cn (str (hd V3100)) (hash-compound-args (tl V3100)))) (true (simple-error "partial function hash-compound-args")))) + +(defun hash-compound (V3101 V3102) (hash (cn (str V3101) (hash-compound-args V3102)) 1000000007)) + +(defun alpha-canonicalize (V3103) V3103) + +(defun content-hash* (V3106) (cond ((and (cons? V3106) (and (= sym (hd V3106)) (and (cons? (tl V3106)) (= () (tl (tl V3106)))))) (cons ch (cons (hash-atom "sym" (hd (tl V3106))) ()))) ((symbol? V3106) (cons ch (cons (hash-atom "sym" V3106) ()))) ((and (cons? V3106) (and (= int (hd V3106)) (and (cons? (tl V3106)) (= () (tl (tl V3106)))))) (cons ch (cons (hash-atom "int" (hd (tl V3106))) ()))) ((and (cons? V3106) (and (= rat (hd V3106)) (and (cons? (tl V3106)) (and (cons? (tl (tl V3106))) (= () (tl (tl (tl V3106)))))))) (cons ch (cons (hash (cn "rat" (cn (str (hd (tl V3106))) (cn "/" (str (hd (tl (tl V3106))))))) 1000000007) ()))) ((cons? V3106) (let W3107 (content-hash* (hd V3106)) (let W3108 (canonical-arg-hashes (hd V3106) (tl V3106)) (cons ch (cons (hash-compound (unwrap-ch W3107) (map (lambda Z3109 (unwrap-ch Z3109)) W3108)) ()))))) (true (cons ch (cons (hash-atom "other" 0) ()))))) + +(defun content-hash (V3110) (content-hash* (alpha-canonicalize V3110))) + +(defun unwrap-ch (V3111) (cond ((and (cons? V3111) (and (= ch (hd V3111)) (and (cons? (tl V3111)) (= () (tl (tl V3111)))))) (hd (tl V3111))) (true (simple-error "partial function unwrap-ch")))) + +(defun make-sym (V3112) (cons sym (cons V3112 ()))) + +(defun make-int (V3113) (cons int (cons V3113 ()))) + +(defun make-compound (V3114 V3115) (cons V3114 V3115)) + +(defun cas-intern (V3116) (let W3117 (alpha-canonicalize V3116) (let W3118 (content-hash* W3117) (intern-lookup (unwrap-ch W3118) (value *intern-table*))))) + +(defun cas-intern! (V3119) (let W3120 (alpha-canonicalize V3119) (let W3121 (content-hash* W3120) (let W3122 (unwrap-ch W3121) (let W3123 (intern-lookup W3122 (value *intern-table*)) (if (assoc-hit? W3123) (hd (tl W3123)) (let W3124 W3120 (let W3125 (set *intern-table* (intern-store W3122 W3124 (value *intern-table*))) W3124)))))))) + +(defun content-eq (V3126 V3127) (= (content-hash V3126) (content-hash V3127))) + +(set *structural-sigs* ()) + +(defun assoc-hit? (V3128) (if (cons? V3128) (not (empty? V3128)) false)) + +(defun sig-present? (V3129) (assoc-hit? (assoc V3129 (value *structural-sigs*)))) + +(defun declare-structural-sig (V3130 V3131) (if (sig-present? V3130) (simple-error (cn "structural sig already declared for " (shen.app V3130 "" shen.a))) (do (set *structural-sigs* (cons (cons V3130 V3131) (value *structural-sigs*))) true))) + +(defun get-structural-sig (V3132) (assoc V3132 (value *structural-sigs*))) + +(defun ensure-structural-sig (V3133) (if (sig-present? V3133) true (declare-structural-sig V3133 ()))) + +(defun structural-sig-contains-name? (V3134 V3135) (let W3136 (get-structural-sig V3134) (if (sig-present? V3134) (element? V3135 (map (lambda Z3137 (str Z3137)) (tl W3136))) false))) + +(defun has-flat? (V3138) (structural-sig-contains-name? V3138 "flat")) + +(defun has-orderless? (V3139) (structural-sig-contains-name? V3139 "orderless")) + +(defun sym? (V3140) (cond ((and (cons? V3140) (and (= sym (hd V3140)) (and (cons? (tl V3140)) (and (= () (tl (tl V3140))) (symbol? (hd (tl V3140))))))) true) (true false))) + +(defun sym-name (V3143) (cond ((sym? V3143) (hd (tl V3143))) (true (simple-error "sym-name: not a sym")))) + +(defun headed-by-sym? (V3144 V3145) (and (cons? V3145) (let W3146 (hd V3145) (and (sym? W3146) (= (sym-name W3146) V3144))))) + +(defun canonical-arg-hashes (V3147 V3148) (if (sym? V3147) (let W3149 (sym-name V3147) (let W3150 (if (has-flat? W3149) (flatten-args-for-hash W3149 V3148) (map (lambda Z3151 (content-hash Z3151)) V3148)) (if (has-orderless? W3149) (sort-hashes W3150) W3150))) (map (lambda Z3152 (content-hash Z3152)) V3148))) + +(defun flatten-args-for-hash (V3153 V3154) (cond ((= () V3154) ()) ((cons? V3154) (if (headed-by-sym? V3153 (hd V3154)) (append (flatten-args-for-hash V3153 (tl (hd V3154))) (flatten-args-for-hash V3153 (tl V3154))) (cons (content-hash (hd V3154)) (flatten-args-for-hash V3153 (tl V3154))))) (true (simple-error "partial function flatten-args-for-hash")))) + +(defun sort-hashes (V3155) (sort-hashes-by (lambda Z3156 (lambda Z3157 (<= (unwrap-ch Z3156) (unwrap-ch Z3157)))) V3155)) + +(defun sort-hashes-by (V3160 V3161) (cond ((= () V3161) ()) ((cons? V3161) (insert-by V3160 (hd V3161) (sort-hashes-by V3160 (tl V3161)))) (true (simple-error "partial function sort-hashes-by")))) + +(defun insert-by (V3164 V3165 V3166) (cond ((= () V3166) (cons V3165 ())) ((cons? V3166) (if ((V3164 V3165) (hd V3166)) (cons V3165 V3166) (cons (hd V3166) (insert-by V3164 V3165 (tl V3166))))) (true (simple-error "partial function insert-by")))) + +(set *normal-form-cache* ()) + +(defun nf-cache-key (V3167 V3168) (cons (unwrap-ch V3167) (cons V3168 ()))) + +(defun nf-lookup (V3169) (assoc V3169 (value *normal-form-cache*))) + +(defun nf-store! (V3170 V3171) (set *normal-form-cache* (adjoin (cons V3170 (cons V3171 ())) (value *normal-form-cache*)))) + +(pr "store.shen loaded (Merkle hash + attrs flat/orderless canonical in content-hash path + nf memo). +" (stoutput)) + +(defun sym (V3172) (cas-intern! (make-sym V3172))) + +(defun int (V3173) (cas-intern! (make-int V3173))) + +(defun compound (V3174 V3175) (cas-intern! (make-compound V3174 V3175))) + +(defun pretty-expr (V3176) (cond ((and (cons? V3176) (and (= sym (hd V3176)) (and (cons? (tl V3176)) (= () (tl (tl V3176)))))) (hd (tl V3176))) ((and (cons? V3176) (and (= int (hd V3176)) (and (cons? (tl V3176)) (= () (tl (tl V3176)))))) (hd (tl V3176))) ((and (cons? V3176) (and (= rat (hd V3176)) (and (cons? (tl V3176)) (and (cons? (tl (tl V3176))) (= () (tl (tl (tl V3176)))))))) (cons (hd (tl V3176)) (cons / (tl (tl V3176))))) ((cons? V3176) (cons (pretty-expr (hd V3176)) (map (lambda Z3177 (pretty-expr Z3177)) (tl V3176)))) (true V3176))) + +(pr "expr.shen loaded (datatypes + store constructors). +" (stoutput)) + +(defun blank () (cons (intern "blank") ())) + +(defun blank-seq () (cons (intern "blank-seq") ())) + +(defun blank-null () (cons (intern "blank-null-seq") ())) + +(defun named (V3178 V3179) (cons (intern "named") (cons V3178 (cons V3179 ())))) + +(defun condition (V3180 V3181) (cons (intern "condition") (cons V3180 (cons V3181 ())))) + +(defun ptest (V3182 V3183) (cons (intern "ptest") (cons V3182 (cons V3183 ())))) + +(defun alt (V3184 V3185) (cons (intern "alt") (cons V3184 (cons V3185 ())))) + +(defun blank? (V3186) (and (cons? V3186) (= (hd V3186) (intern "blank")))) + +(defun blank-typed? (V3187) (and (cons? V3187) (and (= (hd V3187) (intern "blank")) (cons? (tl V3187))))) + +(defun named? (V3188) (and (cons? V3188) (and (= (hd V3188) (intern "named")) (= (length V3188) 3)))) + +(defun named-name (V3189) (if (named? V3189) (hd (tl V3189)) (simple-error (cn "named-name: not a named form " (shen.app V3189 "" shen.a))))) + +(defun named-subpattern (V3190) (if (named? V3190) (hd (tl (tl V3190))) (simple-error (cn "named-subpattern: not a named form " (shen.app V3190 "" shen.a))))) + +(defun seq-pattern? (V3191) (or (blank-seq? V3191) (blank-null-seq? V3191))) + +(defun blank-seq? (V3192) (and (cons? V3192) (= (hd V3192) (intern "blank-seq")))) + +(defun blank-null-seq? (V3193) (and (cons? V3193) (= (hd V3193) (intern "blank-null-seq")))) + +(defun condition? (V3194) (and (cons? V3194) (and (= (hd V3194) (intern "condition")) (cons? (tl V3194))))) + +(defun ptest? (V3195) (and (cons? V3195) (and (= (hd V3195) (intern "ptest")) (cons? (tl V3195))))) + +(defun alt? (V3196) (and (cons? V3196) (and (= (hd V3196) (intern "alt")) (cons? (tl V3196))))) + +(defun tagged-pattern-form? (V3199) (or (named? V3199) (or (blank? V3199) (or (blank-typed? V3199) (or (condition? V3199) (or (ptest? V3199) (or (alt? V3199) (seq-pattern? V3199)))))))) + +(defun expr-form? (V3202) (and (cons? V3202) (element? (hd V3202) (cons (intern "sym") (cons (intern "int") (cons (intern "rat") (cons (intern "real") (cons (intern "str") ())))))))) + +(defun compound-pattern? (V3205) (and (cons? V3205) (and (not (tagged-pattern-form? V3205)) (not (expr-form? V3205))))) + +(defun compound-pattern-head (V3206) (if (compound-pattern? V3206) (hd V3206) (simple-error (cn "compound-pattern-head: not " (shen.app V3206 "" shen.a))))) + +(defun compound-pattern-args (V3207) (if (compound-pattern? V3207) (tl V3207) (simple-error (cn "compound-pattern-args: not " (shen.app V3207 "" shen.a))))) + +(defun alt-left (V3208) (if (alt? V3208) (hd (tl V3208)) (simple-error (cn "alt-left " (shen.app V3208 "" shen.a))))) + +(defun alt-right (V3209) (if (alt? V3209) (hd (tl (tl V3209))) (simple-error (cn "alt-right " (shen.app V3209 "" shen.a))))) + +(defun condition-pattern (V3210) (if (condition? V3210) (hd (tl V3210)) (simple-error (cn "condition-pattern " (shen.app V3210 "" shen.a))))) + +(defun ptest-pattern (V3211) (if (ptest? V3211) (hd (tl V3211)) (simple-error (cn "ptest-pattern " (shen.app V3211 "" shen.a))))) + +(defun pattern? (V3212) (or (blank? V3212) (or (blank-typed? V3212) (or (named? V3212) (or (condition? V3212) (or (ptest? V3212) (or (alt? V3212) (or (compound-pattern? V3212) (expr-form? V3212))))))))) + +(defun extract-bindings (V3213) (if (named? V3213) (cons (named-name V3213) (extract-bindings (named-subpattern V3213))) (if (seq-pattern? V3213) () (if (compound-pattern? V3213) (append (extract-bindings (compound-pattern-head V3213)) (mapcan (lambda Z3214 (extract-bindings Z3214)) (compound-pattern-args V3213))) (if (alt? V3213) (append (extract-bindings (alt-left V3213)) (extract-bindings (alt-right V3213))) (if (condition? V3213) (extract-bindings (condition-pattern V3213)) (if (ptest? V3213) (extract-bindings (ptest-pattern V3213)) ()))))))) + +(defun my-remove (V3215 V3216) (if (cons? V3216) (if (= V3215 (hd V3216)) (my-remove V3215 (tl V3216)) (cons (hd V3216) (my-remove V3215 (tl V3216)))) ())) + +(defun dedup (V3217) (if (cons? V3217) (cons (hd V3217) (dedup (my-remove (hd V3217) (tl V3217)))) ())) + +(defun unique-bindings (V3218) (dedup V3218)) + +(defun bindings (V3219) (unique-bindings (extract-bindings V3219))) + +(defun has-bindings? (V3220) (not (empty? (extract-bindings V3220)))) + +(pr "pattern.shen loaded (datatypes + reserved ctors + robust extract-bindings + pattern utilities). +" (stoutput)) + +(set *num-overflow-check* true) + +(defun int64-max () 9223372036854775807) + +(defun int64-min () -9.223372036854776e+18) + +(defun overflow? (V3221) (if (value *num-overflow-check*) (or (>= V3221 (int64-max)) (<= V3221 (int64-min))) false)) + +(defun guard-int (V3222) (if (overflow? V3222) (do (pr (cn "WARNING: int64 overflow in numeric op: " (shen.app V3222 " +" shen.a)) (stoutput)) (simple-error "int64 overflow")) V3222)) + +(defun abs-num (V3223) (if (< V3223 0) (- 0 V3223) V3223)) + +(defun gcd (V3224 V3225) (cond ((= 0 V3225) (abs-num V3224)) (true (gcd V3225 (- V3224 (* (intdiv V3224 V3225) V3225)))))) + +(defun intdiv (V3226 V3227) (let W3228 (round-toward-zero V3226 V3227) W3228)) + +(defun round-toward-zero (V3229 V3230) (let W3231 (/ V3229 V3230) (let W3232 (truncate-float W3231) W3232))) + +(defun truncate-float (V3233) (if (< V3233 0) (- 0 (floor-nonneg (- 0 V3233))) (floor-nonneg V3233))) + +(defun floor-nonneg (V3234) (if (integer? V3234) V3234 (floor-iter V3234 0))) + +(defun floor-iter (V3235 V3236) (if (>= (- V3235 (+ V3236 1)) 0) (floor-iter V3235 (+ V3236 1)) V3236)) + +(defun make-rat (V3241 V3242) (cond ((= 0 V3242) (simple-error "make-rat: zero denominator")) ((= 0 V3241) (cons int (cons 0 ()))) (true (let W3243 (if (< V3242 0) -1 1) (let W3244 (* W3243 V3241) (let W3245 (* W3243 V3242) (let W3246 (gcd (abs-num W3244) (abs-num W3245)) (let W3247 (intdiv W3244 W3246) (let W3248 (intdiv W3245 W3246) (if (= W3248 1) (cons int (cons W3247 ())) (cons rat (cons W3247 (cons W3248 ()))))))))))))) + +(defun as-rat (V3249) (cond ((and (cons? V3249) (and (= int (hd V3249)) (and (cons? (tl V3249)) (= () (tl (tl V3249)))))) (cons (hd (tl V3249)) (cons 1 ()))) ((and (cons? V3249) (and (= rat (hd V3249)) (and (cons? (tl V3249)) (and (cons? (tl (tl V3249))) (= () (tl (tl (tl V3249)))))))) (tl V3249)) (true (simple-error "partial function as-rat")))) + +(defun rat-num (V3252) (cond ((and (cons? V3252) (and (cons? (tl V3252)) (= () (tl (tl V3252))))) (hd V3252)) (true (simple-error "partial function rat-num")))) + +(defun rat-den (V3255) (cond ((and (cons? V3255) (and (cons? (tl V3255)) (= () (tl (tl V3255))))) (hd (tl V3255))) (true (simple-error "partial function rat-den")))) + +(defun num-add (V3256 V3257) (let W3258 (as-rat V3256) (let W3259 (as-rat V3257) (let W3260 (rat-num W3258) (let W3261 (rat-den W3258) (let W3262 (rat-num W3259) (let W3263 (rat-den W3259) (make-rat (guard-int (+ (* W3260 W3263) (* W3262 W3261))) (guard-int (* W3261 W3263)))))))))) + +(defun num-sub (V3264 V3265) (let W3266 (as-rat V3264) (let W3267 (as-rat V3265) (let W3268 (rat-num W3266) (let W3269 (rat-den W3266) (let W3270 (rat-num W3267) (let W3271 (rat-den W3267) (make-rat (guard-int (- (* W3268 W3271) (* W3270 W3269))) (guard-int (* W3269 W3271)))))))))) + +(defun num-mul (V3272 V3273) (let W3274 (as-rat V3272) (let W3275 (as-rat V3273) (let W3276 (rat-num W3274) (let W3277 (rat-den W3274) (let W3278 (rat-num W3275) (let W3279 (rat-den W3275) (make-rat (guard-int (* W3276 W3278)) (guard-int (* W3277 W3279)))))))))) + +(defun num-div (V3280 V3281) (let W3282 (as-rat V3280) (let W3283 (as-rat V3281) (let W3284 (rat-num W3282) (let W3285 (rat-den W3282) (let W3286 (rat-num W3283) (let W3287 (rat-den W3283) (if (= W3286 0) (simple-error "num-div: division by zero") (make-rat (guard-int (* W3284 W3287)) (guard-int (* W3285 W3286))))))))))) + +(defun num-pow (V3288 V3289) (cond ((= 0 V3289) (cons int (cons 1 ()))) (true (if (< V3289 0) (num-div (cons int (cons 1 ())) (num-pow-pos V3288 (- 0 V3289))) (num-pow-pos V3288 V3289))))) + +(defun num-pow-pos (V3290 V3291) (cond ((= 0 V3291) (cons int (cons 1 ()))) (true (num-mul V3290 (num-pow-pos V3290 (- V3291 1)))))) + +(defun numeric? (V3294) (cond ((and (cons? V3294) (and (= int (hd V3294)) (and (cons? (tl V3294)) (= () (tl (tl V3294)))))) (number? (hd (tl V3294)))) ((and (cons? V3294) (and (= rat (hd V3294)) (and (cons? (tl V3294)) (and (cons? (tl (tl V3294))) (= () (tl (tl (tl V3294)))))))) (and (number? (hd (tl V3294))) (number? (hd (tl (tl V3294)))))) (true false))) + +(defun num-eq? (V3295 V3296) (let W3297 (as-rat V3295) (let W3298 (as-rat V3296) (and (= (rat-num W3297) (rat-num W3298)) (= (rat-den W3297) (rat-den W3298)))))) + +(defun all-numeric? (V3299) (cond ((= () V3299) true) ((cons? V3299) (if (numeric? (hd V3299)) (all-numeric? (tl V3299)) false)) (true (simple-error "partial function all-numeric?")))) + +(defun num-builtin (V3300 V3301) (if (all-numeric? V3301) (trap-error (num-apply V3300 V3301) (lambda Z3302 (cons none ()))) (cons none ()))) + +(defun num-apply (V3307 V3308) (cond ((and (cons? V3307) (and (= sym (hd V3307)) (and (cons? (tl V3307)) (= () (tl (tl V3307)))))) (num-apply-by-name (str (hd (tl V3307))) V3308)) (true (cons none ())))) + +(defun num-apply-by-name (V3313 V3314) (cond ((= "Plus" V3313) (cons some (cons (num-sum (cons int (cons 0 ())) V3314) ()))) ((= "Times" V3313) (cons some (cons (num-prod (cons int (cons 1 ())) V3314) ()))) ((and (= "Minus" V3313) (and (cons? V3314) (and (cons? (tl V3314)) (= () (tl (tl V3314)))))) (cons some (cons (num-sub (hd V3314) (hd (tl V3314))) ()))) ((and (= "Divide" V3313) (and (cons? V3314) (and (cons? (tl V3314)) (= () (tl (tl V3314)))))) (num-apply-div (hd V3314) (hd (tl V3314)))) ((and (= "Power" V3313) (and (cons? V3314) (and (cons? (tl V3314)) (and (cons? (hd (tl V3314))) (and (= int (hd (hd (tl V3314)))) (and (cons? (tl (hd (tl V3314)))) (and (= () (tl (tl (hd (tl V3314))))) (= () (tl (tl V3314)))))))))) (num-apply-pow (hd V3314) (hd (tl (hd (tl V3314)))))) (true (cons none ())))) + +(defun num-apply-pow (V3315 V3316) (if (and (num-eq? V3315 (cons int (cons 0 ()))) (= V3316 0)) (cons none ()) (cons some (cons (num-pow V3315 V3316) ())))) + +(defun num-apply-div (V3317 V3318) (if (num-eq? V3318 (cons int (cons 0 ()))) (cons none ()) (cons some (cons (num-div V3317 V3318) ())))) + +(defun num-sum (V3319 V3320) (cond ((= () V3320) V3319) ((cons? V3320) (num-sum (num-add V3319 (hd V3320)) (tl V3320))) (true (simple-error "partial function num-sum")))) + +(defun num-prod (V3321 V3322) (cond ((= () V3322) V3321) ((cons? V3322) (num-prod (num-mul V3321 (hd V3322)) (tl V3322))) (true (simple-error "partial function num-prod")))) + +(pr "num.shen (int + exact rationals + builtin arith) loaded. +" (stoutput)) + +(defun empty-db () ()) + +(defun db-datoms (V3323) V3323) + +(defun filter (V3326 V3327) (cond ((= () V3327) ()) ((cons? V3327) (if (V3326 (hd V3327)) (cons (hd V3327) (filter V3326 (tl V3327))) (filter V3326 (tl V3327)))) (true (simple-error "partial function filter")))) + +(defun basis-token (V3328) (cond ((= () V3328) "[]") ((cons? V3328) (cn "[" (cn (basis-token (hd V3328)) (cn "|" (cn (basis-token (tl V3328)) "]"))))) ((symbol? V3328) (str V3328)) ((number? V3328) (str V3328)) (true (str V3328)))) + +(defun compute-basis (V3329) (cn "basis:" (str (hash (basis-token V3329) 1000000007)))) + +(defun db-basis (V3330) (compute-basis (db-datoms V3330))) + +(defun basis-hash-eq? (V3331 V3332) (= V3331 V3332)) + +(defun make-rule-datum (V3333 V3334) (cons rule (cons V3333 (cons V3334 ())))) + +(defun make-rule-stub (V3335 V3336) (cons rule (cons V3335 (cons V3336 ())))) + +(defun assert-rule (V3337 V3338 V3339 V3340) (append (db-datoms V3337) (cons (cons V3338 (cons V3339 (cons V3340 (cons (length (db-datoms V3337)) ())))) ()))) + +(defun assert-attribute (V3341 V3342 V3343) (append (db-datoms V3341) (cons (cons V3342 (cons V3343 (cons (length (db-datoms V3341)) ()))) ()))) + +(defun rule-datom? (V3344) (and (cons? V3344) (and (= (length V3344) 4) (element? (hd (tl V3344)) (cons own (cons down (cons up ()))))))) + +(defun attr-datom? (V3345) (and (cons? V3345) (= (length V3345) 3))) + +(defun symbol-entry-view (V3346 V3347) (let W3348 (db-datoms V3346) (let W3349 (filter (lambda Z3350 (and (= (hd Z3350) V3347) (rule-datom? Z3350))) W3348) (let W3351 (filter (lambda Z3352 (and (= (hd Z3352) V3347) (attr-datom? Z3352))) W3348) (let W3353 (map (lambda Z3354 (hd (tl (tl Z3354)))) (filter (lambda Z3355 (= (hd (tl Z3355)) own)) W3349)) (let W3356 (map (lambda Z3357 (hd (tl (tl Z3357)))) (filter (lambda Z3358 (= (hd (tl Z3358)) down)) W3349)) (let W3359 (map (lambda Z3360 (hd (tl (tl Z3360)))) (filter (lambda Z3361 (= (hd (tl Z3361)) up)) W3349)) (let W3362 (map (lambda Z3363 (hd (tl Z3363))) W3351) (cons V3347 (cons W3353 (cons W3356 (cons W3359 (cons W3362 ()))))))))))))) + +(defun db-fork (V3364) (db-datoms V3364)) + +(defun db-fork-with (V3365 V3366) (append (db-datoms V3365) V3366)) + +(defun db-size (V3367) (length (db-datoms V3367))) + +(defun db-rule-count (V3368) (length (filter (lambda Z3369 (rule-datom? Z3369)) (db-datoms V3368)))) + +(defun head-attrs (V3370 V3371) (hd (tl (tl (tl (tl (symbol-entry-view V3370 V3371))))))) + +(defun attr-present? (V3372 V3373 V3374) (element? V3374 (head-attrs V3372 V3373))) + +(defun holds-all? (V3375 V3376) (attr-present? V3375 V3376 (intern "hold-all"))) + +(defun holds-first? (V3377 V3378) (attr-present? V3377 V3378 (intern "hold-first"))) + +(defun holds-rest? (V3379 V3380) (attr-present? V3379 V3380 (intern "hold-rest"))) + +(defun listable? (V3381 V3382) (attr-present? V3381 V3382 (intern "listable"))) + +(defun rule (V3383 V3384) (cons rule (cons V3383 (cons V3384 ())))) + +(defun free-symbols (V3387) (cond ((and (cons? V3387) (and (= sym (hd V3387)) (and (cons? (tl V3387)) (= () (tl (tl V3387)))))) (tl V3387)) ((and (cons? V3387) (and (= int (hd V3387)) (and (cons? (tl V3387)) (and (= () (tl (tl V3387))) (number? (hd (tl V3387))))))) ()) ((and (cons? V3387) (and (= rat (hd V3387)) (and (cons? (tl V3387)) (and (cons? (tl (tl V3387))) (and (= () (tl (tl (tl V3387)))) (and (number? (hd (tl V3387))) (number? (hd (tl (tl V3387)))))))))) ()) ((cons? V3387) (append (free-symbols (hd V3387)) (mapcan (lambda Z3388 (free-symbols Z3388)) (tl V3387)))) (true ()))) + +(defun phase1-globals () (cons Plus (cons Times (cons Minus (cons Divide (cons Power (cons If (cons True (cons False (cons List (cons D (cons Integrate (cons Sin (cons Cos (cons Tan (cons Sec (cons Exp (cons Log (cons Sqrt (cons ArcSin (cons ArcCos (cons ArcTan (cons Equal (cons Solve (cons Series (cons Limit (cons Plus (cons Times ())))))))))))))))))))))))))))) + +(defun known-symbol? (V3389) (element? V3389 (phase1-globals))) + +(defun rule-filter (V3392 V3393) (cond ((= () V3393) ()) ((cons? V3393) (if (V3392 (hd V3393)) (cons (hd V3393) (rule-filter V3392 (tl V3393))) (rule-filter V3392 (tl V3393)))) (true (simple-error "partial function rule-filter")))) + +(defun rule-lhs (V3396) (cond ((and (cons? V3396) (and (= rule (hd V3396)) (and (cons? (tl V3396)) (and (cons? (tl (tl V3396))) (= () (tl (tl (tl V3396)))))))) (hd (tl V3396))) (true (simple-error "partial function rule-lhs")))) + +(defun rule-rhs (V3399) (cond ((and (cons? V3399) (and (= rule (hd V3399)) (and (cons? (tl V3399)) (and (cons? (tl (tl V3399))) (= () (tl (tl (tl V3399)))))))) (hd (tl (tl V3399)))) (true (simple-error "partial function rule-rhs")))) + +(defun bindings-cover? (V3400 V3401) (let W3402 (extract-bindings V3400) (let W3403 (free-symbols V3401) (let W3404 (rule-filter (lambda Z3405 (not (or (element? Z3405 W3402) (known-symbol? Z3405)))) W3403) (if (empty? W3404) true (do (pr (cn "bindings-cover? failed unbound: " (shen.app W3404 " +" shen.a)) (stoutput)) false)))))) + +(set *db* (empty-db)) + +(defun lhs-dispatch-pattern (V3406) (if (condition? V3406) (lhs-dispatch-pattern (condition-pattern V3406)) (if (ptest? V3406) (lhs-dispatch-pattern (ptest-pattern V3406)) V3406))) + +(defun rule-head (V3409) (cond ((and (cons? V3409) (and (= rule (hd V3409)) (and (cons? (tl V3409)) (and (cons? (tl (tl V3409))) (= () (tl (tl (tl V3409)))))))) (let W3410 (lhs-dispatch-pattern (hd (tl V3409))) (if (cons? W3410) (hd W3410) W3410))) (true (simple-error "partial function rule-head")))) + +(defun register-rule (V3411) (if (checked-rule? V3411) (if (bindings-cover? (rule-lhs V3411) (rule-rhs V3411)) (let W3412 (rule-head V3411) (let W3413 down (let W3414 (assert-rule (value *db*) W3412 W3413 V3411) (let W3415 (set *db* W3414) (let W3416 (trap-error (warn-on-rule-registration V3411) (lambda Z3417 true)) V3411))))) (simple-error (cn "register-rule: not a checked-rule or bindings not covered " (shen.app V3411 "" shen.a)))) (simple-error (cn "register-rule: not a checked-rule or bindings not covered " (shen.app V3411 "" shen.a))))) + +(defun valid-rule-lhs? (V3418) (let W3419 (lhs-dispatch-pattern V3418) (and (cons? W3419) (sym? (hd W3419))))) + +(defun checked-rule? (V3420) (cond ((and (cons? V3420) (and (= rule (hd V3420)) (and (cons? (tl V3420)) (and (cons? (tl (tl V3420))) (= () (tl (tl (tl V3420)))))))) (valid-rule-lhs? (hd (tl V3420)))) (true false))) + +(pr "rule.shen loaded (checked-rule + bindings-cover). +" (stoutput)) + +(defun structural-attributes () (cons (intern "flat") (cons (intern "orderless") (cons (intern "one-identity") ())))) + +(defun control-attributes () (cons (intern "hold-all") (cons (intern "hold-first") (cons (intern "hold-rest") (cons (intern "listable") ()))))) + +(defun attribute? (V3421) (or (element? V3421 (structural-attributes)) (element? V3421 (control-attributes)))) + +(defun structural-attribute? (V3422) (element? V3422 (structural-attributes))) + +(defun control-attribute? (V3423) (element? V3423 (control-attributes))) + +(defun attr-name? (V3424 V3425) (= (str V3424) V3425)) + +(defun attr-list-has-name? (V3426 V3427) (cond ((= () V3427) false) ((cons? V3427) (if (attr-name? (hd V3427) V3426) true (attr-list-has-name? V3426 (tl V3427)))) (true (simple-error "partial function attr-list-has-name?")))) + +(defun consistent? (V3432 V3433) (cond ((attr-name? V3432 "hold-all") (not (or (attr-list-has-name? "hold-first" V3433) (or (attr-list-has-name? "hold-rest" V3433) (attr-list-has-name? "listable" V3433))))) ((attr-name? V3432 "listable") (not (attr-list-has-name? "hold-all" V3433))) (true true))) + +(defun consistent-attrs? (V3434) (cond ((= () V3434) true) ((cons? V3434) (and (attribute? (hd V3434)) (and (consistent? (hd V3434) (tl V3434)) (consistent-attrs? (tl V3434))))) (true (simple-error "partial function consistent-attrs?")))) + +(defun list? (V3435) (cond ((= () V3435) true) ((cons? V3435) true) (true false))) + +(defun attrs-filter (V3438 V3439) (cond ((= () V3439) ()) ((cons? V3439) (if (V3438 (hd V3439)) (cons (hd V3439) (attrs-filter V3438 (tl V3439))) (attrs-filter V3438 (tl V3439)))) (true (simple-error "partial function attrs-filter")))) + +(defun every (V3442 V3443) (cond ((= () V3443) true) ((cons? V3443) (and (V3442 (hd V3443)) (every V3442 (tl V3443)))) (true (simple-error "partial function every")))) + +(defun valid-attrs? (V3444) (and (list? V3444) (and (every (lambda Z3445 (attribute? Z3445)) V3444) (consistent-attrs? V3444)))) + +(defun register-control-attrs (V3446 V3447) (cond ((= () V3447) V3446) ((cons? V3447) (do (if (control-attribute? (hd V3447)) (set *db* (assert-attribute (value *db*) V3446 (hd V3447))) true) (register-control-attrs V3446 (tl V3447)))) (true (simple-error "partial function register-control-attrs")))) + +(defun declare-symbol (V3448 V3449) (if (not (list? V3449)) (simple-error (cn "declare-symbol: second arg must be a list of attributes, got " (shen.app V3449 "" shen.a))) (if (consistent-attrs? V3449) (let W3450 (attrs-filter (lambda Z3451 (structural-attribute? Z3451)) V3449) (let W3452 (if (empty? W3450) true (declare-structural-sig V3448 W3450)) (let W3453 (register-control-attrs V3448 V3449) (let W3454 (trap-error (warn-on-attribute-declaration V3448) (lambda Z3455 true)) V3448)))) (simple-error (cn "declare-symbol: inconsistent attributes for " (shen.app V3448 (cn ": " (shen.app V3449 " + (rejected combinations: hold-all+hold-{first,rest}, listable+hold-all)" shen.a)) shen.a)))))) + +(defun declare-structural (V3456 V3457) (if (every (lambda Z3458 (structural-attribute? Z3458)) V3457) (declare-symbol V3456 V3457) (simple-error (cn "declare-structural: non-structural attrs supplied for " (shen.app V3456 (cn ": " (shen.app V3457 "" shen.a)) shen.a))))) + +(pr "attrs.shen loaded (structural/control split + consistent? + declare-symbol via store sig). +" (stoutput)) + +(defun my-filter (V3461 V3462) (cond ((= () V3462) ()) ((cons? V3462) (if (V3461 (hd V3462)) (cons (hd V3462) (my-filter V3461 (tl V3462))) (my-filter V3461 (tl V3462)))) (true (simple-error "partial function my-filter")))) + +(defun my-map (V3465 V3466) (cond ((= () V3466) ()) ((cons? V3466) (cons (V3465 (hd V3466)) (my-map V3465 (tl V3466)))) (true (simple-error "partial function my-map")))) + +(defun my-mapcan (V3469 V3470) (cond ((= () V3470) ()) ((cons? V3470) (append (V3469 (hd V3470)) (my-mapcan V3469 (tl V3470)))) (true (simple-error "partial function my-mapcan")))) + +(defun set-member? (V3478 V3479) (cond ((= () V3479) false) ((and (cons? V3479) (= V3478 (hd V3479))) true) ((cons? V3479) (set-member? V3478 (tl V3479))) (true (simple-error "partial function set-member?")))) + +(defun set-adjoin (V3480 V3481) (if (set-member? V3480 V3481) V3481 (cons V3480 V3481))) + +(defun dedup (V3482) (cond ((= () V3482) ()) ((cons? V3482) (set-adjoin (hd V3482) (dedup (tl V3482)))) (true (simple-error "partial function dedup")))) + +(defun set-union (V3483 V3484) (cond ((= () V3483) V3484) ((cons? V3483) (set-union (tl V3483) (set-adjoin (hd V3483) V3484))) (true (simple-error "partial function set-union")))) + +(defun set-subset? (V3487 V3488) (cond ((= () V3487) true) ((cons? V3487) (and (set-member? (hd V3487) V3488) (set-subset? (tl V3487) V3488))) (true (simple-error "partial function set-subset?")))) + +(defun join (V3489 V3490) (dedup (my-mapcan (lambda Z3491 (compose-step Z3491 V3490)) V3489))) + +(defun compose-step (V3496 V3497) (cond ((and (cons? V3496) (and (cons? (tl V3496)) (= () (tl (tl V3496))))) (let W3498 (my-filter (lambda Z3499 (and (cons? Z3499) (= (head Z3499) (hd (tl V3496))))) V3497) (my-map (lambda Z3500 (cons (hd V3496) (cons (head (tail Z3500)) ()))) W3498))) (true ()))) + +(defun lfp (V3501 V3502) (let W3503 (set-union V3501 (V3502 V3501)) (if (set-subset? W3503 V3501) V3501 (lfp W3503 V3502)))) + +(defun reach-step (V3504 V3505) (set-union V3505 (join V3505 V3504))) + +(defun self-edge? (V3509) (cond ((and (cons? V3509) (and (cons? (tl V3509)) (and (= () (tl (tl V3509))) (= (hd V3509) (hd (tl V3509)))))) true) (true false))) + +(defun heads-in-cycles (V3510) (dedup (my-map (lambda Z3511 (head Z3511)) V3510))) + +(defun rule-datom? (V3512) (and (cons? V3512) (and (= (length V3512) 4) (element? (hd (tl V3512)) (cons own (cons down (cons up ()))))))) + +(defun rhs-of-rep (V3515) (cond ((and (cons? V3515) (and (= rule (hd V3515)) (and (cons? (tl V3515)) (and (cons? (tl (tl V3515))) (= () (tl (tl (tl V3515)))))))) (hd (tl (tl V3515)))) (true V3515))) + +(defun head-symbol-from-expr (V3518) (cond ((and (cons? V3518) (and (= sym (hd V3518)) (and (cons? (tl V3518)) (= () (tl (tl V3518)))))) (tl V3518)) ((symbol? V3518) (cons V3518 ())) ((cons? V3518) (append (head-symbol-from-expr (hd V3518)) (my-mapcan (lambda Z3519 (head-symbol-from-expr Z3519)) (tl V3518)))) (true ()))) + +(defun collect-mentioned-heads (V3520) (dedup (head-symbol-from-expr V3520))) + +(defun deps-from-rule-datom (V3521) (let W3522 (hd (tl (tl V3521))) (let W3523 (hd V3521) (let W3524 (rhs-of-rep W3522) (let W3525 (collect-mentioned-heads W3524) (my-map (lambda Z3526 (cons W3523 (cons Z3526 ()))) W3525)))))) + +(defun direct-deps (V3527) (let W3528 (db-datoms V3527) (dedup (my-mapcan (lambda Z3529 (if (rule-datom? Z3529) (deps-from-rule-datom Z3529) ())) W3528)))) + +(defun direct-deps-from-pairs (V3530) (dedup (my-mapcan (lambda Z3531 (let W3532 (head Z3531) (let W3533 (head (tail Z3531)) (my-map (lambda Z3534 (cons W3532 (cons Z3534 ()))) (dedup W3533))))) V3530))) + +(defun rule-dependency-loops (V3535) (let W3536 (direct-deps V3535) (let W3537 (lfp W3536 (lambda Z3538 (reach-step W3536 Z3538))) (heads-in-cycles (my-filter (lambda Z3539 (self-edge? Z3539)) W3537))))) + +(defun rule-dependency-loops-from-edges (V3540) (let W3541 (dedup V3540) (let W3542 (lfp W3541 (lambda Z3543 (reach-step W3541 Z3543))) (heads-in-cycles (my-filter (lambda Z3544 (self-edge? Z3544)) W3542))))) + +(defun reachable-from-edges (V3545) (let W3546 (dedup V3545) (lfp W3546 (lambda Z3547 (reach-step W3546 Z3547))))) + +(set *dispatch-cache* ()) + +(defun dispatch-cache-key (V3548 V3549 V3550) (cons V3548 (cons V3549 (cons V3550 ())))) + +(defun dispatch-lookup (V3551) (assoc V3551 (value *dispatch-cache*))) + +(defun dispatch-cache-hit? (V3552) (if (cons? V3552) (not (empty? V3552)) false)) + +(defun dispatch-store! (V3553 V3554) (set *dispatch-cache* (adjoin (cons V3553 (cons V3554 ())) (value *dispatch-cache*)))) + +(defun expr-head-symbol (V3555) (cond ((and (cons? V3555) (and (cons? (hd V3555)) (and (= sym (hd (hd V3555))) (and (cons? (tl (hd V3555))) (= () (tl (tl (hd V3555)))))))) (hd V3555)) (true (if (cons? V3555) (hd V3555) V3555)))) + +(defun shape-key (V3556) (let W3557 (expr-head-symbol V3556) (let W3558 (if (and (cons? V3556) (cons? (tl V3556))) (length (tl V3556)) 0) (cons W3557 (cons W3558 ()))))) + +(defun compute-cands-for-head (V3559 V3560) (if (not (cons? V3560)) () (let W3561 (symbol-entry-view V3559 V3560) (let W3562 (hd (tl W3561)) (let W3563 (hd (tl (tl W3561))) (let W3564 (hd (tl (tl (tl W3561)))) (append W3562 (append W3563 W3564)))))))) + +(defun dispatch-candidates (V3565 V3566) (let W3567 (db-basis V3565) (let W3568 (expr-head-symbol V3566) (let W3569 (shape-key V3566) (let W3570 (dispatch-cache-key W3567 W3568 W3569) (let W3571 (dispatch-lookup W3570) (if (dispatch-cache-hit? W3571) (hd (tl W3571)) (let W3572 (compute-cands-for-head V3565 W3568) (do (dispatch-store! W3570 W3572) W3572))))))))) + +(defun attr-datom? (V3573) (and (cons? V3573) (= (length V3573) 3))) + +(defun all-heads (V3574) (dedup (my-map (lambda Z3575 (hd Z3575)) (my-filter (lambda Z3576 (rule-datom? Z3576)) (db-datoms V3574))))) + +(defun set-difference (V3577 V3578) (my-filter (lambda Z3579 (not (set-member? Z3579 V3578))) V3577)) + +(defun head-symbol (V3586) (cond ((and (cons? V3586) (and (cons? (hd V3586)) (and (= sym (hd (hd V3586))) (and (cons? (tl (hd V3586))) (= () (tl (tl (hd V3586)))))))) (hd (tl (hd V3586)))) ((and (cons? V3586) (and (= sym (hd V3586)) (and (cons? (tl V3586)) (= () (tl (tl V3586)))))) (hd (tl V3586))) ((cons? V3586) (head-symbol (hd V3586))) ((symbol? V3586) V3586) (true false))) + +(defun covers-patterns? (V3587 V3588) (and (cons? V3587) (and (cons? V3588) (and (((fn equal?) (head-symbol V3587)) (head-symbol V3588)) (>= (length (tl V3587)) (length (tl V3588))))))) + +(defun covers? (V3591) (lambda Z3592 (lambda Z3593 (covers-patterns? Z3592 Z3593)))) + +(defun my-some (V3596 V3597) (cond ((= () V3597) false) ((cons? V3597) (or (V3596 (hd V3597)) (my-some V3596 (tl V3597)))) (true (simple-error "partial function my-some")))) + +(defun unbound-vars (V3598) (let W3599 (all-rule-reps V3598) (my-mapcan (lambda Z3600 (let W3601 (extract-bindings (rule-lhs Z3600)) (let W3602 (free-symbols (rule-rhs Z3600)) (let W3603 (my-filter (lambda Z3604 (not (or (element? Z3604 W3601) (known-symbol? Z3604)))) W3602) (if (empty? W3603) () (cons (cons Z3600 (cons W3603 ())) ())))))) W3599))) + +(defun all-rule-reps (V3605) (my-mapcan (lambda Z3606 (if (rule-datom? Z3606) (cons (hd (tl (tl Z3606))) ()) ())) (db-datoms V3605))) + +(defun symbol-attrs (V3607 V3608) (let W3609 (symbol-entry-view V3607 V3608) (if (cons? W3609) (hd (tl (tl (tl (tl W3609))))) ()))) + +(defun attr-conflicts (V3610) (let W3611 (all-heads V3610) (let W3612 (my-map (lambda Z3613 (hd Z3613)) (my-filter (lambda Z3614 (attr-datom? Z3614)) (db-datoms V3610))) (let W3615 (dedup (append W3611 W3612)) (my-filter (lambda Z3616 (not (consistent-attrs? (symbol-attrs V3610 Z3616)))) W3615))))) + +(defun has-one-identity? (V3617 V3618) (or (structural-sig-contains-name? V3618 "one-identity") (element? (intern "one-identity") (symbol-attrs V3617 V3618)))) + +(defun has-unary-rule? (V3619 V3620) (let W3621 (symbol-entry-view V3619 V3620) (let W3622 (if (cons? W3621) (let W3623 (hd (tl W3621)) (let W3624 (hd (tl (tl W3621))) (let W3625 (if (cons? (tl (tl (tl W3621)))) (hd (tl (tl (tl W3621)))) ()) (append W3623 (append W3624 W3625))))) ()) (my-some (lambda Z3626 (unary-rule-lhs? (rule-lhs Z3626))) W3622)))) + +(defun unary-rule-lhs? (V3627) (and (cons? V3627) (= (length (tl V3627)) 1))) + +(defun oneid-no-unary (V3628) (let W3629 (all-heads V3628) (let W3630 (my-map (lambda Z3631 (hd Z3631)) (my-filter (lambda Z3632 (attr-datom? Z3632)) (db-datoms V3628))) (let W3633 (dedup (append W3629 W3630)) (my-filter (lambda Z3634 (and (has-one-identity? V3628 Z3634) (not (has-unary-rule? V3628 Z3634)))) W3633))))) + +(defun oneid-no-unary-brute (V3635) (let W3636 (my-filter (lambda Z3637 (has-one-identity? V3635 Z3637)) (all-heads V3635)) (let W3638 (my-filter (lambda Z3639 (has-unary-rule? V3635 Z3639)) W3636) (set-difference W3636 W3638)))) + +(defun warn-unbound-in-db (V3640) (let W3641 (unbound-vars V3640) (if (empty? W3641) true (do (pr (cn "WARN [unbound-vars]: rules with potential unbound RHS: " (shen.app W3641 " +" shen.a)) (stoutput)) false)))) + +(defun warn-attr-conflicts (V3642) (let W3643 (attr-conflicts V3642) (if (empty? W3643) true (do (pr (cn "WARN [attr-conflicts]: symbols with inconsistent attrs: " (shen.app W3643 " +" shen.a)) (stoutput)) false)))) + +(defun warn-oneid-no-unary (V3644) (let W3645 (oneid-no-unary V3644) (let W3646 (oneid-no-unary-brute V3644) (do (if (not (empty? W3645)) (pr (cn "WARN [oneid-no-unary]: OneIdentity symbols lacking unary rule: " (shen.app W3645 (cn " (brute: " (shen.app W3646 ") +" shen.a)) shen.a)) (stoutput)) true) (do (if (not (= (length W3645) (length W3646))) (pr (cn "WARN [invariant]: oneid-no-unary vs brute differ: " (shen.app W3645 (cn " vs " (shen.app W3646 " +" shen.a)) shen.a)) (stoutput)) true) (empty? W3645)))))) + +(defun warn-covers-check (V3647) (covers? V3647)) + +(defun run-warns (V3648) (do (warn-unbound-in-db V3648) (do (warn-attr-conflicts V3648) (do (warn-oneid-no-unary V3648) true)))) + +(defun warn-on-rule-registration (V3651) (run-warns (value *db*))) + +(defun warn-on-attribute-declaration (V3654) (run-warns (value *db*))) + +(pr "warn.shen loaded (analysis warnings at reg time: unbound, attr-conflicts, oneid-no-unary). +" (stoutput)) + +(defun match-some (V3655) (cons just (cons V3655 ()))) + +(defun match-none () (cons none ())) + +(defun match-some? (V3656) (if (cons? V3656) (= (hd V3656) just) false)) + +(defun match-unwrap (V3657) (cond ((and (cons? V3657) (and (= just (hd V3657)) (and (cons? (tl V3657)) (= () (tl (tl V3657)))))) (hd (tl V3657))) (true (simple-error "partial function match-unwrap")))) + +(defun merge-bindings (V3658 V3659) (if (bindings-compatible? V3658 V3659) (match-some (append V3658 V3659)) match-none)) + +(defun bindings-compatible? (V3664 V3665) (cond ((= () V3664) true) ((and (cons? V3664) (and (cons? (hd V3664)) (and (cons? (tl (hd V3664))) (= () (tl (tl (hd V3664))))))) (if (binding-conflicts? (hd (hd V3664)) (hd (tl (hd V3664))) V3665) false (bindings-compatible? (tl V3664) V3665))) ((cons? V3664) (bindings-compatible? (tl V3664) V3665)) (true (simple-error "partial function bindings-compatible?")))) + +(defun binding-conflicts? (V3666 V3667 V3668) (let W3669 (assoc V3666 V3668) (if (assoc-hit? W3669) (not (binding-vals-equal? V3667 (hd (tl W3669)))) false))) + +(defun binding-vals-equal? (V3670 V3671) (if (or (seqval? V3670) (seqval? V3671)) (= V3670 V3671) (content-eq V3670 V3671))) + +(defun match (V3684 V3685) (cond ((and (cons? V3684) (and (= blank (hd V3684)) (= () (tl V3684)))) (match-some ())) ((and (cons? V3684) (and (= blank (hd V3684)) (and (cons? (tl V3684)) (and (= () (tl (tl V3684))) (and (cons? V3685) (and (cons? (hd V3685)) (and (= sym (hd (hd V3685))) (and (cons? (tl (hd V3685))) (and (= () (tl (tl (hd V3685)))) (= (hd (tl V3684)) (hd (tl (hd V3685))))))))))))) (match-some ())) ((and (cons? V3684) (and (= blank (hd V3684)) (and (cons? (tl V3684)) (= () (tl (tl V3684)))))) match-none) ((and (cons? V3684) (and (= named (hd V3684)) (and (cons? (tl V3684)) (and (cons? (tl (tl V3684))) (= () (tl (tl (tl V3684)))))))) (let W3686 (match (hd (tl (tl V3684))) V3685) (if (match-some? W3686) (match-some (cons (cons (hd (tl V3684)) (cons V3685 ())) (match-unwrap W3686))) match-none))) ((and (= V3684 V3685) (not (expr-compound? V3685))) (match-some ())) ((and (cons? V3684) (and (= ptest (hd V3684)) (and (cons? (tl V3684)) (and (cons? (tl (tl V3684))) (= () (tl (tl (tl V3684)))))))) (let W3687 (match (hd (tl V3684)) V3685) (if (match-some? W3687) (if (eval-to-true? (normal-form (cons (hd (tl (tl V3684))) (cons V3685 ())))) W3687 match-none) match-none))) ((and (cons? V3684) (and (= condition (hd V3684)) (and (cons? (tl V3684)) (and (cons? (tl (tl V3684))) (= () (tl (tl (tl V3684)))))))) (let W3688 (match (hd (tl V3684)) V3685) (if (match-some? W3688) (if (eval-to-true? (normal-form (substitute (match-unwrap W3688) (hd (tl (tl V3684)))))) W3688 match-none) match-none))) ((and (cons? V3684) (cons? V3685)) (match-compound (hd V3684) (tl V3684) (hd V3685) (tl V3685))) (true match-none))) + +(defun match-compound (V3689 V3690 V3691 V3692) (let W3693 (match V3689 V3691) (if (match-some? W3693) (let W3694 (match-arg-list V3690 V3692) (if (match-some? W3694) (merge-bindings (match-unwrap W3693) (match-unwrap W3694)) match-none)) match-none))) + +(defun match-arg-list (V3699 V3700) (cond ((and (= () V3699) (= () V3700)) (match-some ())) ((and (cons? V3699) (cons? V3700)) (let W3701 (match (hd V3699) (hd V3700)) (if (match-some? W3701) (let W3702 (match-arg-list (tl V3699) (tl V3700)) (if (match-some? W3702) (merge-bindings (match-unwrap W3701) (match-unwrap W3702)) match-none)) match-none))) (true match-none))) + +(defun expr-atom? (V3703) (cond ((and (cons? V3703) (and (= sym (hd V3703)) (and (cons? (tl V3703)) (and (= () (tl (tl V3703))) (symbol? (hd (tl V3703))))))) true) ((and (cons? V3703) (and (= int (hd V3703)) (and (cons? (tl V3703)) (and (= () (tl (tl V3703))) (number? (hd (tl V3703))))))) true) ((and (cons? V3703) (and (= rat (hd V3703)) (and (cons? (tl V3703)) (and (cons? (tl (tl V3703))) (and (= () (tl (tl (tl V3703)))) (and (number? (hd (tl V3703))) (number? (hd (tl (tl V3703)))))))))) true) (true false))) + +(defun expr-compound? (V3706) (cond ((cons? V3706) (and (not (expr-atom? V3706)) (cons? (tl V3706)))) (true false))) + +(defun substitute (V3707 V3708) (cond ((= () V3707) V3708) ((and (cons? V3707) (and (cons? (hd V3707)) (and (cons? (tl (hd V3707))) (= () (tl (tl (hd V3707))))))) (substitute (tl V3707) (replace-free (hd (hd V3707)) (hd (tl (hd V3707))) V3708))) (true (simple-error "partial function substitute")))) + +(defun seqval? (V3709) (and (cons? V3709) (= (hd V3709) (intern "seqval")))) + +(defun seqval-items (V3710) (tl V3710)) + +(defun replace-free (V3712 V3713 V3714) (cond ((and (cons? V3714) (and (= sym (hd V3714)) (and (cons? (tl V3714)) (and (= () (tl (tl V3714))) (= V3712 (hd (tl V3714))))))) V3713) ((and (cons? V3714) (and (= sym (hd V3714)) (and (cons? (tl V3714)) (= () (tl (tl V3714)))))) V3714) ((and (cons? V3714) (and (= int (hd V3714)) (and (cons? (tl V3714)) (= () (tl (tl V3714)))))) V3714) ((and (cons? V3714) (and (= rat (hd V3714)) (and (cons? (tl V3714)) (and (cons? (tl (tl V3714))) (= () (tl (tl (tl V3714)))))))) V3714) ((cons? V3714) (cons (replace-free-head V3712 V3713 (hd V3714)) (replace-free-args V3712 V3713 (tl V3714)))) (true V3714))) + +(defun replace-free-head (V3715 V3716 V3717) (let W3718 (replace-free V3715 V3716 V3717) (if (seqval? W3718) (if (cons? (seqval-items W3718)) (hd (seqval-items W3718)) W3718) W3718))) + +(defun replace-free-args (V3719 V3720 V3721) (cond ((= () V3721) ()) ((cons? V3721) (let W3722 (replace-free V3719 V3720 (hd V3721)) (let W3723 (replace-free-args V3719 V3720 (tl V3721)) (if (seqval? W3722) (append (seqval-items W3722) W3723) (cons W3722 W3723))))) (true (simple-error "partial function replace-free-args")))) + +(defun eval-to-true? (V3726) (cond ((and (cons? V3726) (and (= sym (hd V3726)) (and (cons? (tl V3726)) (and (= () (tl (tl V3726))) (= (hd (tl V3726)) True))))) true) (true false))) + +(pr "match.shen loaded (first-order match + substitute). +" (stoutput)) + +(defun match-arg-list-positional (V3731 V3732) (cond ((and (= () V3731) (= () V3732)) (match-some ())) ((and (cons? V3731) (cons? V3732)) (let W3733 (match (hd V3731) (hd V3732)) (if (match-some? W3733) (let W3734 (match-arg-list-positional (tl V3731) (tl V3732)) (if (match-some? W3734) (merge-bindings (match-unwrap W3733) (match-unwrap W3734)) match-none)) match-none))) (true match-none))) + +(defun seq-pattern-elem? (V3741) (cond ((and (cons? V3741) (and (= blank-seq (hd V3741)) (= () (tl V3741)))) true) ((and (cons? V3741) (and (= blank-null-seq (hd V3741)) (= () (tl V3741)))) true) ((and (cons? V3741) (and (= named (hd V3741)) (and (cons? (tl V3741)) (and (cons? (tl (tl V3741))) (and (cons? (hd (tl (tl V3741)))) (and (= blank-seq (hd (hd (tl (tl V3741))))) (and (= () (tl (hd (tl (tl V3741))))) (= () (tl (tl (tl V3741))))))))))) true) ((and (cons? V3741) (and (= named (hd V3741)) (and (cons? (tl V3741)) (and (cons? (tl (tl V3741))) (and (cons? (hd (tl (tl V3741)))) (and (= blank-null-seq (hd (hd (tl (tl V3741))))) (and (= () (tl (hd (tl (tl V3741))))) (= () (tl (tl (tl V3741))))))))))) true) (true false))) + +(defun has-seq-var? (V3744) (cond ((= () V3744) false) ((cons? V3744) (if (seq-pattern-elem? (hd V3744)) true (has-seq-var? (tl V3744)))) (true false))) + +(defun split (V3745 V3746 V3747 V3748 V3749 V3750 V3751) (let W3752 (if (shen.unlocked? V3749) (let W3753 (shen.lazyderef V3746 V3748) (let W3754 (freeze (do (shen.incinfs) (is! V3745 V3747 V3748 V3749 V3750 V3751))) (if (= W3753 ()) (thaw W3754) (if (shen.pvar? W3753) (shen.bind! W3753 () V3748 W3754) false)))) false) (if (= W3752 false) (if (shen.unlocked? V3749) (let W3755 (shen.lazyderef V3745 V3748) (let W3756 (lambda Z3757 (lambda Z3758 (let W3759 (shen.lazyderef V3746 V3748) (let W3760 (lambda Z3761 (lambda Z3762 (do (shen.incinfs) (is! Z3757 Z3761 V3748 V3749 V3750 (freeze (split Z3758 Z3762 V3747 V3748 V3749 V3750 V3751)))))) (if (cons? W3759) (let W3763 (hd W3759) (let W3764 (tl W3759) ((W3760 W3763) W3764))) (if (shen.pvar? W3759) (let W3765 (shen.newpv V3748) (shen.gc V3748 (let W3766 (shen.newpv V3748) (shen.gc V3748 (shen.bind! W3759 (cons W3765 W3766) V3748 (freeze ((W3760 W3765) W3766))))))) false)))))) (if (cons? W3755) (let W3767 (hd W3755) (let W3768 (tl W3755) ((W3756 W3767) W3768))) (if (shen.pvar? W3755) (let W3769 (shen.newpv V3748) (shen.gc V3748 (let W3770 (shen.newpv V3748) (shen.gc V3748 (shen.bind! W3755 (cons W3769 W3770) V3748 (freeze ((W3756 W3769) W3770))))))) false)))) false) W3752))) + +(defun all-splits (V3771) (all-splits-acc () V3771)) + +(defun all-splits-acc (V3772 V3773) (cons (cons (reverse V3772) (cons V3773 ())) (if (cons? V3773) (all-splits-acc (cons (hd V3773) V3772) (tl V3773)) ()))) + +(defun match-args-with-sequences (V3774 V3775) (seq-match V3774 V3775)) + +(defun seq-match (V3778 V3779) (cond ((and (= () V3778) (= () V3779)) (match-some ())) ((= () V3778) match-none) ((cons? V3778) (if (seq-pattern-elem? (hd V3778)) (seq-match-seqvar (hd V3778) (tl V3778) V3779) (seq-match-normal (hd V3778) (tl V3778) V3779))) (true (simple-error "partial function seq-match")))) + +(defun seq-match-normal (V3784 V3785 V3786) (cond ((= () V3786) match-none) ((cons? V3786) (let W3787 (match V3784 (hd V3786)) (if (match-some? W3787) (let W3788 (seq-match V3785 (tl V3786)) (if (match-some? W3788) (merge-bindings (match-unwrap W3787) (match-unwrap W3788)) match-none)) match-none))) (true (simple-error "partial function seq-match-normal")))) + +(defun seq-match-seqvar (V3789 V3790 V3791) (seq-try-splits V3789 V3790 (seq-valid-splits V3789 V3791))) + +(defun seq-valid-splits (V3792 V3793) (seq-filter-splits (seq-min-one? V3792) (all-splits V3793))) + +(defun seq-min-one? (V3798) (cond ((and (cons? V3798) (and (= blank-seq (hd V3798)) (= () (tl V3798)))) true) ((and (cons? V3798) (and (= named (hd V3798)) (and (cons? (tl V3798)) (and (cons? (tl (tl V3798))) (and (cons? (hd (tl (tl V3798)))) (and (= blank-seq (hd (hd (tl (tl V3798))))) (and (= () (tl (hd (tl (tl V3798))))) (= () (tl (tl (tl V3798))))))))))) true) (true false))) + +(defun seq-filter-splits (V3801 V3802) (cond ((= () V3802) ()) ((and (cons? V3802) (and (cons? (hd V3802)) (and (cons? (tl (hd V3802))) (= () (tl (tl (hd V3802))))))) (if (and V3801 (= (hd (hd V3802)) ())) (seq-filter-splits V3801 (tl V3802)) (cons (hd V3802) (seq-filter-splits V3801 (tl V3802))))) (true (simple-error "partial function seq-filter-splits")))) + +(defun seq-try-splits (V3807 V3808 V3809) (cond ((= () V3809) match-none) ((and (cons? V3809) (and (cons? (hd V3809)) (and (cons? (tl (hd V3809))) (= () (tl (tl (hd V3809))))))) (let W3810 (seq-match V3808 (hd (tl (hd V3809)))) (if (match-some? W3810) (let W3811 (merge-bindings (seq-binding V3807 (hd (hd V3809))) (match-unwrap W3810)) (if (match-some? W3811) W3811 (seq-try-splits V3807 V3808 (tl V3809)))) (seq-try-splits V3807 V3808 (tl V3809))))) (true (simple-error "partial function seq-try-splits")))) + +(defun seq-binding (V3818 V3819) (cond ((and (cons? V3818) (and (= named (hd V3818)) (and (cons? (tl V3818)) (and (cons? (tl (tl V3818))) (= () (tl (tl (tl V3818)))))))) (cons (cons (hd (tl V3818)) (cons (cons (intern "seqval") V3819) ())) ())) (true ()))) + +(defun match-arg-list (V3820 V3821) (cond ((and (= () V3820) (= () V3821)) (match-some ())) (true (if (has-seq-var? V3820) (match-args-with-sequences V3820 V3821) (match-arg-list-positional V3820 V3821))))) + +(pr "match-seq.shen loaded (defprolog split + pure-Shen seq matcher + seq-aware match-arg-list). +" (stoutput)) + +(set *ac-max-args* 8) + +(defun ac-known-heads () (cons (cons sym (cons Plus ())) (cons (cons sym (cons Times ())) (cons Plus (cons Times ()))))) + +(defun is-ac-head? (V3822) (cond ((cons? V3822) (element? V3822 (ac-known-heads))) (true (element? V3822 (ac-known-heads))))) + +(defun ac-head-has-orderless? (V3823) (or (is-ac-head? V3823) (if (sym? V3823) (has-orderless? (sym-name V3823)) false))) + +(defun ac-head-has-flat? (V3824) (or (is-ac-head? V3824) (if (sym? V3824) (has-flat? (sym-name V3824)) false))) + +(defun count-seq-vars (V3825) (cond ((= () V3825) 0) ((and (cons? V3825) (and (cons? (hd V3825)) (and (= blank-seq (hd (hd V3825))) (= () (tl (hd V3825)))))) (+ 1 (count-seq-vars (tl V3825)))) ((and (cons? V3825) (and (cons? (hd V3825)) (and (= blank-null-seq (hd (hd V3825))) (= () (tl (hd V3825)))))) (+ 1 (count-seq-vars (tl V3825)))) ((and (cons? V3825) (and (cons? (hd V3825)) (and (= named (hd (hd V3825))) (and (cons? (tl (hd V3825))) (and (cons? (tl (tl (hd V3825)))) (and (cons? (hd (tl (tl (hd V3825))))) (and (= blank-seq (hd (hd (tl (tl (hd V3825)))))) (and (= () (tl (hd (tl (tl (hd V3825)))))) (= () (tl (tl (tl (hd V3825))))))))))))) (+ 1 (count-seq-vars (tl V3825)))) ((and (cons? V3825) (and (cons? (hd V3825)) (and (= named (hd (hd V3825))) (and (cons? (tl (hd V3825))) (and (cons? (tl (tl (hd V3825)))) (and (cons? (hd (tl (tl (hd V3825))))) (and (= blank-null-seq (hd (hd (tl (tl (hd V3825)))))) (and (= () (tl (hd (tl (tl (hd V3825)))))) (= () (tl (tl (tl (hd V3825))))))))))))) (+ 1 (count-seq-vars (tl V3825)))) ((cons? V3825) (count-seq-vars (tl V3825))) (true (simple-error "partial function count-seq-vars")))) + +(defun count-anchors (V3826) (- (length V3826) (count-seq-vars V3826))) + +(defun ac-blowup-warning (V3827 V3828) (if (and (ac-head-has-flat? V3827) (and (ac-head-has-orderless? V3827) (and (> (count-seq-vars V3828) 1) (= (count-anchors V3828) 0)))) (do (pr (cn "WARNING: AC blowup risk for " (shen.app V3827 " (Flat+Orderless + >1 unanchored seq var) +" shen.a)) (stoutput)) true) true)) + +(defun flatten-flat (V3829 V3830) (cond ((= () V3830) ()) ((cons? V3830) (if (and (sym? V3829) (headed-by-sym? (sym-name V3829) (hd V3830))) (append (flatten-flat V3829 (tl (hd V3830))) (flatten-flat V3829 (tl V3830))) (cons (hd V3830) (flatten-flat V3829 (tl V3830))))) (true (simple-error "partial function flatten-flat")))) + +(defun flatten-flat-args (V3831 V3832) (if (ac-head-has-flat? V3831) (flatten-flat V3831 V3832) V3832)) + +(defun ac-permutations (V3833) (cond ((= () V3833) (cons () ())) (true (ac-perm-insert-each V3833)))) + +(defun ac-perm-insert-each (V3834) (ac-perm-loop V3834 V3834)) + +(defun ac-perm-loop (V3837 V3838) (cond ((= () V3837) ()) ((cons? V3837) (append (ac-prepend-all (hd V3837) (ac-permutations (ac-remove-first (hd V3837) V3838))) (ac-perm-loop (tl V3837) V3838))) (true (simple-error "partial function ac-perm-loop")))) + +(defun ac-prepend-all (V3841 V3842) (cond ((= () V3842) ()) ((cons? V3842) (cons (cons V3841 (hd V3842)) (ac-prepend-all V3841 (tl V3842)))) (true (simple-error "partial function ac-prepend-all")))) + +(defun ac-remove-first (V3845 V3846) (cond ((= () V3846) ()) ((cons? V3846) (if (= V3845 (hd V3846)) (tl V3846) (cons (hd V3846) (ac-remove-first V3845 (tl V3846))))) (true (simple-error "partial function ac-remove-first")))) + +(defun match-orderless (V3847 V3848 V3849) (if (> (length V3849) (value *ac-max-args*)) (do (pr (cn "WARNING: AC permutation search skipped for " (shen.app V3847 (cn " (>" (shen.app (value *ac-max-args*) " args) +" shen.a)) shen.a)) (stoutput)) (match-arg-list V3848 V3849)) (let W3850 (ac-permutations V3849) (if (needs-self-binding-score? V3848 V3849) (match-orderless-best V3848 W3850 match-none -1 (self-binding-candidate-count V3848 V3849)) (match-orderless-perms V3848 W3850))))) + +(defun match-orderless-perms (V3853 V3854) (cond ((= () V3854) match-none) ((cons? V3854) (let W3855 (match-arg-list V3853 (hd V3854)) (if (match-some? W3855) W3855 (match-orderless-perms V3853 (tl V3854))))) (true (simple-error "partial function match-orderless-perms")))) + +(defun match-orderless-best (V3862 V3863 V3864 V3865 V3866) (cond ((= () V3863) V3864) ((cons? V3863) (let W3867 (match-arg-list V3862 (hd V3863)) (if (match-some? W3867) (let W3868 (binding-list-score (match-unwrap W3867)) (if (> W3868 V3865) (if (= W3868 V3866) W3867 (match-orderless-best V3862 (tl V3863) W3867 W3868 V3866)) (match-orderless-best V3862 (tl V3863) V3864 V3865 V3866))) (match-orderless-best V3862 (tl V3863) V3864 V3865 V3866)))) (true (simple-error "partial function match-orderless-best")))) + +(defun binding-list-score (V3872) (cond ((= () V3872) 0) ((and (cons? V3872) (and (cons? (hd V3872)) (and (cons? (tl (hd V3872))) (and (cons? (hd (tl (hd V3872)))) (and (= sym (hd (hd (tl (hd V3872))))) (and (cons? (tl (hd (tl (hd V3872))))) (and (= () (tl (tl (hd (tl (hd V3872)))))) (and (= () (tl (tl (hd V3872)))) (= (hd (hd V3872)) (hd (tl (hd (tl (hd V3872)))))))))))))) (+ 1 (binding-list-score (tl V3872)))) ((cons? V3872) (binding-list-score (tl V3872))) (true (simple-error "partial function binding-list-score")))) + +(defun needs-self-binding-score? (V3873 V3874) (and (<= (length V3874) 2) (has-self-binding-candidate? V3873 V3874))) + +(defun has-self-binding-candidate? (V3879 V3880) (cond ((= () V3879) false) ((and (cons? V3879) (and (cons? (hd V3879)) (and (= named (hd (hd V3879))) (and (cons? (tl (hd V3879))) (and (cons? (tl (tl (hd V3879)))) (and (cons? (hd (tl (tl (hd V3879))))) (and (= blank (hd (hd (tl (tl (hd V3879)))))) (and (= () (tl (hd (tl (tl (hd V3879)))))) (= () (tl (tl (tl (hd V3879))))))))))))) (if (expr-list-contains-sym? (hd (tl (hd V3879))) V3880) true (has-self-binding-candidate? (tl V3879) V3880))) ((cons? V3879) (has-self-binding-candidate? (tl V3879) V3880)) (true (simple-error "partial function has-self-binding-candidate?")))) + +(defun self-binding-candidate-count (V3885 V3886) (cond ((= () V3885) 0) ((and (cons? V3885) (and (cons? (hd V3885)) (and (= named (hd (hd V3885))) (and (cons? (tl (hd V3885))) (and (cons? (tl (tl (hd V3885)))) (and (cons? (hd (tl (tl (hd V3885))))) (and (= blank (hd (hd (tl (tl (hd V3885)))))) (and (= () (tl (hd (tl (tl (hd V3885)))))) (= () (tl (tl (tl (hd V3885))))))))))))) (if (expr-list-contains-sym? (hd (tl (hd V3885))) V3886) (+ 1 (self-binding-candidate-count (tl V3885) V3886)) (self-binding-candidate-count (tl V3885) V3886))) ((cons? V3885) (self-binding-candidate-count (tl V3885) V3886)) (true (simple-error "partial function self-binding-candidate-count")))) + +(defun expr-list-contains-sym? (V3894 V3895) (cond ((= () V3895) false) ((and (cons? V3895) (and (cons? (hd V3895)) (and (= sym (hd (hd V3895))) (and (cons? (tl (hd V3895))) (and (= () (tl (tl (hd V3895)))) (= V3894 (hd (tl (hd V3895))))))))) true) ((cons? V3895) (expr-list-contains-sym? V3894 (tl V3895))) (true (simple-error "partial function expr-list-contains-sym?")))) + +(defun match-compound (V3896 V3897 V3898 V3899) (let W3900 (match V3896 V3898) (if (match-some? W3900) (let W3901 (if (cons? V3898) (flatten-flat-args V3898 V3899) V3899) (let W3902 (if (cons? V3898) (ac-blowup-warning V3898 V3897) true) (let W3903 (if (and (cons? V3898) (ac-head-has-orderless? V3898)) (match-orderless V3898 V3897 W3901) (match-arg-list V3897 W3901)) (if (match-some? W3903) (merge-bindings (match-unwrap W3900) (match-unwrap W3903)) match-none)))) match-none))) + +(pr "match-ac.shen loaded (orderless perm any-seq-count + flat nested flatten + blowup warning). +" (stoutput)) + +(defun calc-true () (cons sym (cons True ()))) + +(defun calc-false () (cons sym (cons False ()))) + +(defun bool->expr (V3904) (cond ((= true V3904) (calc-true)) ((= false V3904) (calc-false)) (true (simple-error "partial function bool->expr")))) + +(defun occurs-in? (V3908 V3909) (cond ((= V3908 V3909) true) ((and (cons? V3909) (and (= sym (hd V3909)) (and (cons? (tl V3909)) (= () (tl (tl V3909)))))) false) ((and (cons? V3909) (and (= int (hd V3909)) (and (cons? (tl V3909)) (= () (tl (tl V3909)))))) false) ((and (cons? V3909) (and (= rat (hd V3909)) (and (cons? (tl V3909)) (and (cons? (tl (tl V3909))) (= () (tl (tl (tl V3909)))))))) false) ((cons? V3909) (if (occurs-in? V3908 (hd V3909)) true (occurs-in-list? V3908 (tl V3909)))) (true false))) + +(defun occurs-in-list? (V3910 V3911) (cond ((= () V3911) false) ((cons? V3911) (if (occurs-in? V3910 (hd V3911)) true (occurs-in-list? V3910 (tl V3911)))) (true (simple-error "partial function occurs-in-list?")))) + +(defun free-of? (V3912 V3913) (not (occurs-in? V3913 V3912))) + +(defun number-expr? (V3916) (cond ((and (cons? V3916) (and (= int (hd V3916)) (and (cons? (tl V3916)) (= () (tl (tl V3916)))))) (number? (hd (tl V3916)))) ((and (cons? V3916) (and (= rat (hd V3916)) (and (cons? (tl V3916)) (and (cons? (tl (tl V3916))) (= () (tl (tl (tl V3916)))))))) (and (number? (hd (tl V3916))) (number? (hd (tl (tl V3916)))))) (true false))) + +(defun calc-builtin (V3921 V3922) (cond ((and (cons? V3921) (and (= sym (hd V3921)) (and (cons? (tl V3921)) (= () (tl (tl V3921)))))) (calc-by-name (str (hd (tl V3921))) V3922)) (true (cons none ())))) + +(defun positive-expr? (V3925) (cond ((and (cons? V3925) (and (= int (hd V3925)) (and (cons? (tl V3925)) (and (= () (tl (tl V3925))) (number? (hd (tl V3925))))))) (> (hd (tl V3925)) 0)) ((and (cons? V3925) (and (= rat (hd V3925)) (and (cons? (tl V3925)) (and (cons? (tl (tl V3925))) (and (= () (tl (tl (tl V3925)))) (and (number? (hd (tl V3925))) (number? (hd (tl (tl V3925)))))))))) (> (hd (tl V3925)) 0)) (true false))) + +(defun calc-by-name (V3930 V3931) (cond ((and (= "SameQ" V3930) (and (cons? V3931) (and (cons? (tl V3931)) (= () (tl (tl V3931)))))) (cons some (cons (bool->expr (content-eq (hd V3931) (hd (tl V3931)))) ()))) ((and (= "UnsameQ" V3930) (and (cons? V3931) (and (cons? (tl V3931)) (= () (tl (tl V3931)))))) (cons some (cons (bool->expr (not (content-eq (hd V3931) (hd (tl V3931))))) ()))) ((and (= "FreeQ" V3930) (and (cons? V3931) (and (cons? (tl V3931)) (= () (tl (tl V3931)))))) (cons some (cons (bool->expr (free-of? (hd V3931) (hd (tl V3931)))) ()))) ((and (= "NumberQ" V3930) (and (cons? V3931) (= () (tl V3931)))) (cons some (cons (bool->expr (number-expr? (hd V3931))) ()))) ((and (= "Positive" V3930) (and (cons? V3931) (= () (tl V3931)))) (cons some (cons (bool->expr (positive-expr? (hd V3931))) ()))) ((= "And" V3930) (cons some (cons (bool->expr (all-true? V3931)) ()))) ((and (= "Simplify" V3930) (and (cons? V3931) (= () (tl V3931)))) (cons some (cons (collect-like-terms (hd V3931)) ()))) ((and (= "Expand" V3930) (and (cons? V3931) (= () (tl V3931)))) (cons some (cons (poly-expand (hd V3931)) ()))) ((and (= "PolynomialQ" V3930) (and (cons? V3931) (and (cons? (tl V3931)) (= () (tl (tl V3931)))))) (cons some (cons (bool->expr (polynomial-q? (hd V3931) (hd (tl V3931)))) ()))) ((and (= "PolynomialGCD" V3930) (and (cons? V3931) (and (cons? (tl V3931)) (= () (tl (tl V3931)))))) (poly-gcd-builtin (hd V3931) (hd (tl V3931)))) ((and (= "Cancel" V3930) (and (cons? V3931) (= () (tl V3931)))) (cancel-builtin (hd V3931))) ((and (= "Together" V3930) (and (cons? V3931) (= () (tl V3931)))) (together-builtin (hd V3931))) ((and (= "Factor" V3930) (and (cons? V3931) (= () (tl V3931)))) (factor-builtin (hd V3931))) ((and (= "Apart" V3930) (and (cons? V3931) (= () (tl V3931)))) (apart-builtin (hd V3931))) ((and (= "Solve" V3930) (and (cons? V3931) (and (cons? (tl V3931)) (= () (tl (tl V3931)))))) (solve-builtin (hd V3931) (hd (tl V3931)))) ((and (= "Integrate" V3930) (and (cons? V3931) (and (cons? (tl V3931)) (= () (tl (tl V3931)))))) (integrate-wired (hd V3931) (hd (tl V3931)))) ((= "Series" V3930) (series-builtin V3931)) ((= "Limit" V3930) (limit-builtin V3931)) (true (cons none ())))) + +(defun integrate-wired (V3932 V3933) (let W3934 (integrate-pullout V3932 V3933) (if (= W3934 (cons none ())) (integrate-after-pullout V3932 V3933) W3934))) + +(defun integrate-after-pullout (V3935 V3936) (let W3937 (integrate-linear-usub V3935 V3936) (if (= W3937 (cons none ())) (integrate-after-usub V3935 V3936) W3937))) + +(defun integrate-after-usub (V3938 V3939) (let W3940 (integrate-table V3938 V3939) (if (= W3940 (cons none ())) (integrate-after-table V3938 V3939) W3940))) + +(defun integrate-after-table (V3941 V3942) (let W3943 (integrate-invfun V3941 V3942) (if (= W3943 (cons none ())) (integrate-after-invfun V3941 V3942) W3943))) + +(defun integrate-after-invfun (V3944 V3945) (let W3946 (integrate-log-parts V3944 V3945) (if (= W3946 (cons none ())) (integrate-after-log V3944 V3945) W3946))) + +(defun integrate-after-log (V3947 V3948) (let W3949 (integrate-cyclic V3947 V3948) (if (= W3949 (cons none ())) (integrate-after-cyclic V3947 V3948) W3949))) + +(defun integrate-after-cyclic (V3950 V3951) (let W3952 (integrate-trigpow V3950 V3951) (if (= W3952 (cons none ())) (integrate-after-trigpow V3950 V3951) W3952))) + +(defun integrate-after-trigpow (V3953 V3954) (let W3955 (integrate-sincos V3953 V3954) (if (= W3955 (cons none ())) (integrate-after-sincos V3953 V3954) W3955))) + +(defun integrate-after-sincos (V3956 V3957) (let W3958 (integrate-powusub V3956 V3957) (if (= W3958 (cons none ())) (integrate-after-powusub V3956 V3957) W3958))) + +(defun integrate-after-powusub (V3959 V3960) (let W3961 (integrate-arcsin V3959 V3960) (if (= W3961 (cons none ())) (integrate-by-parts V3959 V3960) W3961))) + +(defun integrate-table (V3966 V3967) (cond ((and (cons? V3966) (and (cons? (hd V3966)) (and (= sym (hd (hd V3966))) (and (cons? (tl (hd V3966))) (and (= () (tl (tl (hd V3966)))) (and (cons? (tl V3966)) (and (cons? (tl (tl V3966))) (= () (tl (tl (tl V3966))))))))))) (itable-divide (str (hd (tl (hd V3966)))) (hd (tl V3966)) (hd (tl (tl V3966))) V3967)) (true (cons none ())))) + +(defun itable-divide (V3976 V3977 V3978 V3979) (cond ((= "Divide" V3976) (itable-on-divide V3977 V3978 V3979)) (true (cons none ())))) + +(defun itable-on-divide (V3980 V3981 V3982) (cond ((and (cons? V3980) (and (= int (hd V3980)) (and (cons? (tl V3980)) (and (= 1 (hd (tl V3980))) (= () (tl (tl V3980))))))) (itable-recip V3981 V3982 (expr->coeffs V3982 V3981))) (true (itable-logderiv V3980 V3981 V3982)))) + +(defun itable-recip (V3985 V3986 V3987) (cond ((and (cons? V3987) (and (= some (hd V3987)) (and (cons? (tl V3987)) (and (cons? (hd (tl V3987))) (and (cons? (tl (hd (tl V3987)))) (and (cons? (tl (tl (hd (tl V3987))))) (and (= () (tl (tl (tl (hd (tl V3987)))))) (= () (tl (tl V3987)))))))))) (if (one-zero-one? (hd (hd (tl V3987))) (hd (tl (hd (tl V3987)))) (hd (tl (tl (hd (tl V3987)))))) (cons some (cons (cons (cons sym (cons ArcTan ())) (cons V3986 ())) ())) (cons none ()))) ((and (cons? V3987) (and (= some (hd V3987)) (and (cons? (tl V3987)) (and (cons? (hd (tl V3987))) (and (cons? (tl (hd (tl V3987)))) (and (= () (tl (tl (hd (tl V3987))))) (= () (tl (tl V3987))))))))) (cons some (cons (cons (ct-times) (cons (cons (ct-power) (cons (hd (tl (hd (tl V3987)))) (cons (cons int (cons -1 ())) ()))) (cons (cons (cons sym (cons Log ())) (cons V3985 ())) ()))) ()))) (true (cons none ())))) + +(defun one-zero-one? (V3988 V3989 V3990) (if (content-eq V3988 (cons int (cons 1 ()))) (if (content-eq V3989 (cons int (cons 0 ()))) (content-eq V3990 (cons int (cons 1 ()))) false) false)) + +(defun itable-logderiv (V3991 V3992 V3993) (itable-logderiv-2 V3991 V3992 V3993 (expr->coeffs V3993 V3991) (expr->coeffs V3993 (reduce (cons (cons sym (cons D ())) (cons V3992 (cons V3993 ()))))))) + +(defun itable-logderiv-2 (V3998 V3999 V4000 V4001 V4002) (cond ((and (cons? V4001) (and (= some (hd V4001)) (and (cons? (tl V4001)) (and (= () (tl (tl V4001))) (and (cons? V4002) (and (= some (hd V4002)) (and (cons? (tl V4002)) (= () (tl (tl V4002)))))))))) (itable-logderiv-3 V3999 (vec-ratio (hd (tl V4001)) (hd (tl V4002))))) (true (cons none ())))) + +(defun itable-logderiv-3 (V4005 V4006) (cond ((and (cons? V4006) (and (= some (hd V4006)) (and (cons? (tl V4006)) (= () (tl (tl V4006)))))) (cons some (cons (cons (ct-times) (cons (hd (tl V4006)) (cons (cons (cons sym (cons Log ())) (cons V4005 ())) ()))) ()))) (true (cons none ())))) + +(defun vec-ratio (V4007 V4008) (if (= (length V4007) (length V4008)) (vr-check-ratio V4007 V4008 (num-div (vr-last V4007) (vr-last V4008))) (cons none ()))) + +(defun vr-last (V4011) (cond ((and (cons? V4011) (= () (tl V4011))) (hd V4011)) ((cons? V4011) (vr-last (tl V4011))) (true (simple-error "partial function vr-last")))) + +(defun vr-check-ratio (V4012 V4013 V4014) (if (vr-elementwise? V4012 V4013 V4014) (cons some (cons V4014 ())) (cons none ()))) + +(defun vr-elementwise? (V4023 V4024 V4025) (cond ((and (= () V4023) (= () V4024)) true) ((and (cons? V4023) (cons? V4024)) (if (num-eq? (hd V4023) (num-mul V4025 (hd V4024))) (vr-elementwise? (tl V4023) (tl V4024) V4025) false)) (true false))) + +(defun integrate-linear-usub (V4030 V4031) (cond ((and (cons? V4030) (and (cons? (hd V4030)) (and (= sym (hd (hd V4030))) (and (cons? (tl (hd V4030))) (and (= () (tl (tl (hd V4030)))) (and (cons? (tl V4030)) (= () (tl (tl V4030))))))))) (lusub-by-name (str (hd (tl (hd V4030)))) (hd (tl V4030)) V4031)) (true (cons none ())))) + +(defun lusub-by-name (V4038 V4039 V4040) (cond ((= "Sin" V4038) (lusub-emit "Sin" V4039 V4040)) ((= "Cos" V4038) (lusub-emit "Cos" V4039 V4040)) ((= "Exp" V4038) (lusub-emit "Exp" V4039 V4040)) (true (cons none ())))) + +(defun lusub-emit (V4041 V4042 V4043) (lusub-on-coeffs V4041 V4042 (expr->coeffs V4043 V4042))) + +(defun lusub-on-coeffs (V4046 V4047 V4048) (cond ((and (cons? V4048) (and (= some (hd V4048)) (and (cons? (tl V4048)) (and (cons? (hd (tl V4048))) (and (cons? (tl (hd (tl V4048)))) (and (= () (tl (tl (hd (tl V4048))))) (= () (tl (tl V4048))))))))) (cons some (cons (lusub-form V4046 V4047 (hd (tl (hd (tl V4048))))) ()))) (true (cons none ())))) + +(defun lusub-form (V4049 V4050 V4051) (cond ((= "Sin" V4049) (cons (ct-times) (cons (cons int (cons -1 ())) (cons (cons (ct-power) (cons V4051 (cons (cons int (cons -1 ())) ()))) (cons (cons (cons sym (cons Cos ())) (cons V4050 ())) ()))))) ((= "Cos" V4049) (cons (ct-times) (cons (cons (ct-power) (cons V4051 (cons (cons int (cons -1 ())) ()))) (cons (cons (cons sym (cons Sin ())) (cons V4050 ())) ())))) ((= "Exp" V4049) (cons (ct-times) (cons (cons (ct-power) (cons V4051 (cons (cons int (cons -1 ())) ()))) (cons (cons (cons sym (cons Exp ())) (cons V4050 ())) ())))) (true (simple-error "partial function lusub-form")))) + +(defun integrate-pullout (V4056 V4057) (cond ((and (cons? V4056) (and (cons? (hd V4056)) (and (= sym (hd (hd V4056))) (and (cons? (tl (hd V4056))) (= () (tl (tl (hd V4056)))))))) (integrate-pullout-times (str (hd (tl (hd V4056)))) (tl V4056) V4057)) (true (cons none ())))) + +(defun integrate-pullout-times (V4064 V4065 V4066) (cond ((= "Times" V4064) (pullout-build (partition-free V4066 V4065 () ()) V4066)) (true (cons none ())))) + +(defun partition-free (V4067 V4068 V4069 V4070) (cond ((= () V4068) (cons (reverse V4069) (cons (reverse V4070) ()))) ((cons? V4068) (if (free-of? (hd V4068) V4067) (partition-free V4067 (tl V4068) (cons (hd V4068) V4069) V4070) (partition-free V4067 (tl V4068) V4069 (cons (hd V4068) V4070)))) (true (simple-error "partial function partition-free")))) + +(defun pullout-build (V4071 V4072) (cond ((and (cons? V4071) (and (cons? (tl V4071)) (= () (tl (tl V4071))))) (if (or (empty? (hd V4071)) (empty? (hd (tl V4071)))) (cons none ()) (cons some (cons (cons (ct-times) (cons (ibp-times (hd V4071)) (cons (cons (cons sym (cons Integrate ())) (cons (ibp-times (hd (tl V4071))) (cons V4072 ()))) ()))) ())))) (true (simple-error "partial function pullout-build")))) + +(defun true-expr? (V4075) (cond ((and (cons? V4075) (and (= sym (hd V4075)) (and (cons? (tl V4075)) (= () (tl (tl V4075)))))) (= (hd (tl V4075)) True)) (true false))) + +(defun all-true? (V4076) (cond ((= () V4076) true) ((cons? V4076) (if (true-expr? (hd V4076)) (all-true? (tl V4076)) false)) (true (simple-error "partial function all-true?")))) + +(defun ct-plus () (cons sym (cons Plus ()))) + +(defun ct-times () (cons sym (cons Times ()))) + +(defun ct-power () (cons sym (cons Power ()))) + +(defun plus-head? (V4079) (cond ((and (cons? V4079) (and (= sym (hd V4079)) (and (cons? (tl V4079)) (= () (tl (tl V4079)))))) (= (str (hd (tl V4079))) "Plus")) (true false))) + +(defun times-head? (V4082) (cond ((and (cons? V4082) (and (= sym (hd V4082)) (and (cons? (tl V4082)) (= () (tl (tl V4082)))))) (= (str (hd (tl V4082))) "Times")) (true false))) + +(defun power-head? (V4085) (cond ((and (cons? V4085) (and (= sym (hd V4085)) (and (cons? (tl V4085)) (= () (tl (tl V4085)))))) (= (str (hd (tl V4085))) "Power")) (true false))) + +(defun divide-head? (V4088) (cond ((and (cons? V4088) (and (= sym (hd V4088)) (and (cons? (tl V4088)) (= () (tl (tl V4088)))))) (= (str (hd (tl V4088))) "Divide")) (true false))) + +(defun collect-like-terms (V4089) (cond ((and (cons? V4089) (and (= sym (hd V4089)) (and (cons? (tl V4089)) (= () (tl (tl V4089)))))) V4089) ((and (cons? V4089) (and (= int (hd V4089)) (and (cons? (tl V4089)) (= () (tl (tl V4089)))))) V4089) ((and (cons? V4089) (and (= rat (hd V4089)) (and (cons? (tl V4089)) (and (cons? (tl (tl V4089))) (= () (tl (tl (tl V4089)))))))) V4089) ((and (cons? V4089) (and (cons? (tl V4089)) (and (cons? (tl (tl V4089))) (and (= () (tl (tl (tl V4089)))) (divide-head? (hd V4089)))))) (collect-like-terms (cons (ct-times) (cons (hd (tl V4089)) (cons (cons (ct-power) (cons (hd (tl (tl V4089))) (cons (cons int (cons -1 ())) ()))) ()))))) ((and (cons? V4089) (and (cons? (tl V4089)) (and (cons? (hd (tl V4089))) (and (cons? (tl (hd (tl V4089)))) (and (cons? (tl (tl (hd (tl V4089))))) (and (= () (tl (tl (tl (hd (tl V4089)))))) (and (cons? (tl (tl V4089))) (and (= () (tl (tl (tl V4089)))) (nested-power? (hd V4089) (hd (hd (tl V4089))) (hd (tl (tl (hd (tl V4089))))) (hd (tl (tl V4089)))))))))))) (collect-like-terms (cons (ct-power) (cons (hd (tl (hd (tl V4089)))) (cons (num-mul (hd (tl (tl (hd (tl V4089))))) (hd (tl (tl V4089)))) ()))))) ((cons? V4089) (collect-node (hd V4089) (map (lambda Z4090 (collect-like-terms Z4090)) (tl V4089)))) (true V4089))) + +(defun nested-power? (V4091 V4092 V4093 V4094) (if (power-head? V4091) (if (power-head? V4092) (if (rat-expr? V4093) (number-expr? V4094) false) false) false)) + +(defun rat-expr? (V4097) (cond ((and (cons? V4097) (and (= rat (hd V4097)) (and (cons? (tl V4097)) (and (cons? (tl (tl V4097))) (= () (tl (tl (tl V4097)))))))) (and (number? (hd (tl V4097))) (number? (hd (tl (tl V4097)))))) (true false))) + +(defun collect-node (V4098 V4099) (if (plus-head? V4098) (collect-plus V4099) (if (times-head? V4098) (collect-times-node V4099) (cons V4098 V4099)))) + +(defun collect-times-node (V4100) (if (any-plus-factor? V4100) (collect-like-terms (expand-product V4100)) (collect-times V4100))) + +(defun any-plus-factor? (V4101) (cond ((= () V4101) false) ((cons? V4101) (if (plus-head? (head-of (hd V4101))) true (any-plus-factor? (tl V4101)))) (true (simple-error "partial function any-plus-factor?")))) + +(defun head-of (V4106) (cond ((cons? V4106) (hd V4106)) (true (cons none ())))) + +(defun expand-product (V4107) (let W4108 (expand-factors V4107 (cons () ())) (cons (ct-plus) (map (lambda Z4109 (ibp-times Z4109)) W4108)))) + +(defun expand-factors (V4110 V4111) (cond ((= () V4110) (reverse-each V4111)) ((cons? V4110) (expand-factors (tl V4110) (expand-one (hd V4110) V4111))) (true (simple-error "partial function expand-factors")))) + +(defun expand-one (V4112 V4113) (cond ((and (cons? V4112) (plus-head? (hd V4112))) (cartesian-plus (tl V4112) V4113)) (true (map (lambda Z4114 (cons V4112 Z4114)) V4113)))) + +(defun cartesian-plus (V4115 V4116) (cartesian-loop V4115 V4116 ())) + +(defun cartesian-loop (V4119 V4120 V4121) (cond ((= () V4119) V4121) ((cons? V4119) (cartesian-loop (tl V4119) V4120 (append V4121 (map (lambda Z4122 (cons (hd V4119) Z4122)) V4120)))) (true (simple-error "partial function cartesian-loop")))) + +(defun reverse-each (V4123) (cond ((= () V4123) ()) ((cons? V4123) (cons (reverse (hd V4123)) (reverse-each (tl V4123)))) (true (simple-error "partial function reverse-each")))) + +(defun addend-coeff-base (V4124) (cond ((and (cons? V4124) (and (= int (hd V4124)) (and (cons? (tl V4124)) (= () (tl (tl V4124)))))) (cons V4124 (cons (cons int (cons 1 ())) ()))) ((and (cons? V4124) (and (= rat (hd V4124)) (and (cons? (tl V4124)) (and (cons? (tl (tl V4124))) (= () (tl (tl (tl V4124)))))))) (cons V4124 (cons (cons int (cons 1 ())) ()))) ((and (cons? V4124) (times-head? (hd V4124))) (acb-times (tl V4124))) (true (cons (cons int (cons 1 ())) (cons V4124 ()))))) + +(defun acb-times (V4125) (let W4126 (split-num-factors V4125 (cons int (cons 1 ())) ()) (let W4127 (hd W4126) (let W4128 (hd (tl W4126)) (cons W4127 (cons (times-rest-as-expr W4128) ())))))) + +(defun times-rest-as-expr (V4129) (cond ((= () V4129) (cons int (cons 1 ()))) ((and (cons? V4129) (= () (tl V4129))) (hd V4129)) (true (cons (ct-times) V4129)))) + +(defun plus-groups (V4130 V4131) (cond ((= () V4130) V4131) ((cons? V4130) (plus-groups (tl V4130) (plus-add-group (addend-coeff-base (hd V4130)) V4131))) (true (simple-error "partial function plus-groups")))) + +(defun plus-add-group (V4132 V4133) (cond ((and (cons? V4132) (and (cons? (tl V4132)) (and (= () (tl (tl V4132))) (= () V4133)))) (cons V4132 ())) ((and (cons? V4132) (and (cons? (tl V4132)) (and (= () (tl (tl V4132))) (and (cons? V4133) (and (cons? (hd V4133)) (and (cons? (tl (hd V4133))) (= () (tl (tl (hd V4133)))))))))) (if (content-eq (hd (tl V4132)) (hd (tl (hd V4133)))) (cons (cons (num-sum-2 (hd V4132) (hd (hd V4133))) (tl (hd V4133))) (tl V4133)) (cons (hd V4133) (plus-add-group V4132 (tl V4133))))) (true (simple-error "partial function plus-add-group")))) + +(defun num-sum-2 (V4134 V4135) (num-add V4134 V4135)) + +(defun group->addend (V4136) (cond ((and (cons? V4136) (and (cons? (tl V4136)) (and (cons? (hd (tl V4136))) (and (= int (hd (hd (tl V4136)))) (and (cons? (tl (hd (tl V4136)))) (and (= 1 (hd (tl (hd (tl V4136))))) (and (= () (tl (tl (hd (tl V4136))))) (= () (tl (tl V4136)))))))))) (hd V4136)) ((and (cons? V4136) (and (cons? (tl V4136)) (= () (tl (tl V4136))))) (if (num-eq? (hd V4136) (cons int (cons 0 ()))) (cons int (cons 0 ())) (if (num-eq? (hd V4136) (cons int (cons 1 ()))) (hd (tl V4136)) (cons (ct-times) V4136)))) (true (simple-error "partial function group->addend")))) + +(defun zero-expr? (V4137) (if (number-expr? V4137) (num-eq? V4137 (cons int (cons 0 ()))) false)) + +(defun drop-zeros (V4138) (cond ((= () V4138) ()) ((cons? V4138) (if (zero-expr? (hd V4138)) (drop-zeros (tl V4138)) (cons (hd V4138) (drop-zeros (tl V4138))))) (true (simple-error "partial function drop-zeros")))) + +(defun flatten-plus-args (V4139) (cond ((= () V4139) ()) ((cons? V4139) (append (flatten-plus-arg (hd V4139)) (flatten-plus-args (tl V4139)))) (true (simple-error "partial function flatten-plus-args")))) + +(defun flatten-plus-arg (V4140) (cond ((and (cons? V4140) (plus-head? (hd V4140))) (flatten-plus-args (tl V4140))) (true (cons V4140 ())))) + +(defun pyth-fold-addends (V4141) (let W4142 (pyth-find-pair V4141 V4141) (if (= W4142 (cons none ())) V4141 (pyth-apply W4142 V4141)))) + +(defun pyth-trig-term (V4143 V4144) (pyth-trig-cb V4143 (addend-coeff-base V4144))) + +(defun pyth-trig-cb (V4147 V4148) (cond ((and (cons? V4148) (and (cons? (tl V4148)) (and (cons? (hd (tl V4148))) (and (cons? (hd (hd (tl V4148)))) (and (= sym (hd (hd (hd (tl V4148))))) (and (cons? (tl (hd (hd (tl V4148))))) (and (= () (tl (tl (hd (hd (tl V4148)))))) (and (cons? (tl (hd (tl V4148)))) (and (cons? (hd (tl (hd (tl V4148))))) (and (cons? (hd (hd (tl (hd (tl V4148)))))) (and (= sym (hd (hd (hd (tl (hd (tl V4148))))))) (and (cons? (tl (hd (hd (tl (hd (tl V4148))))))) (and (= () (tl (tl (hd (hd (tl (hd (tl V4148)))))))) (and (cons? (tl (hd (tl (hd (tl V4148)))))) (and (= () (tl (tl (hd (tl (hd (tl V4148))))))) (and (cons? (tl (tl (hd (tl V4148))))) (and (= () (tl (tl (tl (hd (tl V4148)))))) (= () (tl (tl V4148)))))))))))))))))))) (pyth-trig-chk V4147 (hd V4148) (hd (tl (hd (tl (hd (tl V4148)))))) (str (hd (tl (hd (hd (tl V4148)))))) (str (hd (tl (hd (hd (tl (hd (tl V4148)))))))) (hd (tl (tl (hd (tl V4148))))))) (true (cons none ())))) + +(defun pyth-trig-chk (V4149 V4150 V4151 V4152 V4153 V4154) (if (= V4152 "Power") (if (= V4153 V4149) (if (number-expr? V4154) (if (num-eq? V4154 (cons int (cons 2 ()))) (cons some (cons (cons V4150 (cons V4151 ())) ())) (cons none ())) (cons none ())) (cons none ())) (cons none ()))) + +(defun pyth-find-pair (V4157 V4158) (cond ((= () V4157) (cons none ())) ((cons? V4157) (pyth-find-pair-step (pyth-trig-term "Sin" (hd V4157)) (tl V4157) V4158)) (true (simple-error "partial function pyth-find-pair")))) + +(defun pyth-find-pair-step (V4159 V4160 V4161) (cond ((and (cons? V4159) (and (= none (hd V4159)) (= () (tl V4159)))) (pyth-find-pair V4160 V4161)) ((and (cons? V4159) (and (= some (hd V4159)) (and (cons? (tl V4159)) (and (cons? (hd (tl V4159))) (and (cons? (tl (hd (tl V4159)))) (and (= () (tl (tl (hd (tl V4159))))) (= () (tl (tl V4159))))))))) (if (pyth-has-cos? (hd (hd (tl V4159))) (hd (tl (hd (tl V4159)))) V4161) V4159 (pyth-find-pair V4160 V4161))) (true (simple-error "partial function pyth-find-pair-step")))) + +(defun pyth-has-cos? (V4162 V4163 V4164) (cond ((= () V4164) false) ((cons? V4164) (pyth-has-cos-step V4162 V4163 (pyth-trig-term "Cos" (hd V4164)) (tl V4164))) (true (simple-error "partial function pyth-has-cos?")))) + +(defun pyth-has-cos-step (V4165 V4166 V4167 V4168) (cond ((and (cons? V4167) (and (= none (hd V4167)) (= () (tl V4167)))) (pyth-has-cos? V4165 V4166 V4168)) ((and (cons? V4167) (and (= some (hd V4167)) (and (cons? (tl V4167)) (and (cons? (hd (tl V4167))) (and (cons? (tl (hd (tl V4167)))) (and (= () (tl (tl (hd (tl V4167))))) (= () (tl (tl V4167))))))))) (if (num-eq? V4165 (hd (hd (tl V4167)))) (if (content-eq V4166 (hd (tl (hd (tl V4167))))) true (pyth-has-cos? V4165 V4166 V4168)) (pyth-has-cos? V4165 V4166 V4168))) (true (simple-error "partial function pyth-has-cos-step")))) + +(defun pyth-apply (V4169 V4170) (cond ((and (cons? V4169) (and (= some (hd V4169)) (and (cons? (tl V4169)) (and (cons? (hd (tl V4169))) (and (cons? (tl (hd (tl V4169)))) (and (= () (tl (tl (hd (tl V4169))))) (= () (tl (tl V4169))))))))) (pyth-fold-addends (drop-zeros (map (lambda Z4171 (group->addend Z4171)) (plus-groups (cons (hd (hd (tl V4169))) (pyth-drop "Cos" (hd (hd (tl V4169))) (hd (tl (hd (tl V4169)))) (pyth-drop "Sin" (hd (hd (tl V4169))) (hd (tl (hd (tl V4169)))) V4170))) ()))))) (true (simple-error "partial function pyth-apply")))) + +(defun pyth-drop (V4172 V4173 V4174 V4175) (cond ((= () V4175) ()) ((cons? V4175) (pyth-drop-step V4172 V4173 V4174 (hd V4175) (tl V4175) (pyth-trig-term V4172 (hd V4175)))) (true (simple-error "partial function pyth-drop")))) + +(defun pyth-drop-step (V4176 V4177 V4178 V4179 V4180 V4181) (cond ((and (cons? V4181) (and (= none (hd V4181)) (= () (tl V4181)))) (cons V4179 (pyth-drop V4176 V4177 V4178 V4180))) ((and (cons? V4181) (and (= some (hd V4181)) (and (cons? (tl V4181)) (and (cons? (hd (tl V4181))) (and (cons? (tl (hd (tl V4181)))) (and (= () (tl (tl (hd (tl V4181))))) (= () (tl (tl V4181))))))))) (if (num-eq? V4177 (hd (hd (tl V4181)))) (if (content-eq V4178 (hd (tl (hd (tl V4181))))) V4180 (cons V4179 (pyth-drop V4176 V4177 V4178 V4180))) (cons V4179 (pyth-drop V4176 V4177 V4178 V4180)))) (true (simple-error "partial function pyth-drop-step")))) + +(defun collect-plus (V4182) (let W4183 (flatten-plus-args V4182) (let W4184 (plus-groups W4183 ()) (let W4185 (drop-zeros (map (lambda Z4186 (group->addend Z4186)) W4184)) (let W4187 (pyth-fold-addends W4185) (rat-zero-or (rebuild-nary (ct-plus) W4187 (cons int (cons 0 ()))) W4187)))))) + +(defun rat-zero-or (V4188 V4189) (if (rat-has-neg-power? V4189) (rat-try-collapse V4188 V4189 (dedup-syms (free-sym-names V4188))) V4188)) + +(defun rat-try-collapse (V4192 V4193 V4194) (cond ((and (cons? V4194) (= () (tl V4194))) (rat-finish V4192 (rat-combine (cons sym V4194) V4193))) (true V4192))) + +(defun rat-finish (V4195 V4196) (cond ((and (cons? V4196) (and (= some (hd V4196)) (and (cons? (tl V4196)) (= () (tl (tl V4196)))))) (if (vec-zero? (hd (tl V4196))) (cons int (cons 0 ())) V4195)) ((and (cons? V4196) (and (= none (hd V4196)) (= () (tl V4196)))) V4195) (true (simple-error "partial function rat-finish")))) + +(defun vec-zero? (V4197) (empty? (trim-coeffs V4197))) + +(defun rat-combine (V4198 V4199) (rat-combine-loop V4198 V4199 (cons (cons int (cons 0 ())) ()) (cons (cons int (cons 1 ())) ()))) + +(defun rat-combine-loop (V4200 V4201 V4202 V4203) (cond ((= () V4201) (cons some (cons V4202 ()))) ((cons? V4201) (rat-combine-step V4200 (tl V4201) V4202 V4203 (rat-addend->frac V4200 (hd V4201)))) (true (simple-error "partial function rat-combine-loop")))) + +(defun rat-combine-step (V4206 V4207 V4208 V4209 V4210) (cond ((and (cons? V4210) (and (= some (hd V4210)) (and (cons? (tl V4210)) (and (cons? (hd (tl V4210))) (and (cons? (tl (hd (tl V4210)))) (and (= () (tl (tl (hd (tl V4210))))) (= () (tl (tl V4210))))))))) (rat-combine-loop V4206 V4207 (vec-add (vec-mul V4208 (hd (tl (hd (tl V4210))))) (vec-mul (hd (hd (tl V4210))) V4209)) (vec-mul V4209 (hd (tl (hd (tl V4210))))))) (true (cons none ())))) + +(defun rat-addend->frac (V4211 V4212) (af-loop V4211 (rat-frac-flatten V4212) (cons (cons int (cons 1 ())) ()) (cons (cons int (cons 1 ())) ()))) + +(defun rat-frac-flatten (V4213) (cond ((and (cons? V4213) (times-head? (hd V4213))) (tl V4213)) (true (cons V4213 ())))) + +(defun af-loop (V4214 V4215 V4216 V4217) (cond ((= () V4215) (cons some (cons (cons V4216 (cons V4217 ())) ()))) ((cons? V4215) (af-step V4214 (tl V4215) V4216 V4217 (af-classify V4214 (hd V4215)))) (true (simple-error "partial function af-loop")))) + +(defun af-step (V4220 V4221 V4222 V4223 V4224) (cond ((and (cons? V4224) (and (= 0 (hd V4224)) (and (cons? (tl V4224)) (= () (tl (tl V4224)))))) (af-loop V4220 V4221 (vec-mul V4222 (hd (tl V4224))) V4223)) ((and (cons? V4224) (and (= 1 (hd V4224)) (and (cons? (tl V4224)) (= () (tl (tl V4224)))))) (af-loop V4220 V4221 V4222 (vec-mul V4223 (hd (tl V4224))))) (true (cons none ())))) + +(defun af-classify (V4225 V4226) (af-class V4225 V4226 (af-den-of V4225 V4226))) + +(defun af-den-of (V4229 V4230) (cond ((and (cons? V4230) (and (cons? (tl V4230)) (and (cons? (tl (tl V4230))) (and (= () (tl (tl (tl V4230)))) (power-head? (hd V4230)))))) (af-den-pow V4229 (hd (tl V4230)) (hd (tl (tl V4230))))) (true (cons none ())))) + +(defun af-den-pow (V4233 V4234 V4235) (cond ((and (cons? V4235) (and (= int (hd V4235)) (and (cons? (tl V4235)) (= () (tl (tl V4235)))))) (if (< (hd (tl V4235)) 0) (af-den-raise V4233 V4234 (- 0 (hd (tl V4235)))) (cons none ()))) (true (cons none ())))) + +(defun af-den-raise (V4236 V4237 V4238) (af-den-raise-2 (expr->coeffs V4236 V4237) V4238)) + +(defun af-den-raise-2 (V4241 V4242) (cond ((and (cons? V4241) (and (= some (hd V4241)) (and (cons? (tl V4241)) (= () (tl (tl V4241)))))) (cons some (cons (vec-pow (hd (tl V4241)) V4242) ()))) (true (cons none ())))) + +(defun af-class (V4245 V4246 V4247) (cond ((and (cons? V4247) (and (= some (hd V4247)) (and (cons? (tl V4247)) (= () (tl (tl V4247)))))) (cons 1 (tl V4247))) (true (af-class-num (expr->coeffs V4245 V4246))))) + +(defun af-class-num (V4250) (cond ((and (cons? V4250) (and (= some (hd V4250)) (and (cons? (tl V4250)) (= () (tl (tl V4250)))))) (cons 0 (tl V4250))) (true (cons none ())))) + +(defun vec-pow (V4251 V4252) (cond ((= 1 V4252) V4251) (true (vec-mul V4251 (vec-pow V4251 (- V4252 1)))))) + +(defun rat-has-neg-power? (V4253) (cond ((= () V4253) false) ((cons? V4253) (if (expr-has-neg-power? (hd V4253)) true (rat-has-neg-power? (tl V4253)))) (true (simple-error "partial function rat-has-neg-power?")))) + +(defun expr-has-neg-power? (V4266) (cond ((and (cons? V4266) (and (= sym (hd V4266)) (and (cons? (tl V4266)) (= () (tl (tl V4266)))))) false) ((and (cons? V4266) (and (= int (hd V4266)) (and (cons? (tl V4266)) (= () (tl (tl V4266)))))) false) ((and (cons? V4266) (and (= rat (hd V4266)) (and (cons? (tl V4266)) (and (cons? (tl (tl V4266))) (= () (tl (tl (tl V4266)))))))) false) ((and (cons? V4266) (and (cons? (tl V4266)) (and (cons? (tl (tl V4266))) (and (= () (tl (tl (tl V4266)))) (power-head? (hd V4266)))))) (rat-np-power (hd V4266) (hd (tl V4266)) (hd (tl (tl V4266))))) ((cons? V4266) (expr-any-neg-power? (tl V4266))) (true false))) + +(defun rat-np-power (V4267 V4268 V4269) (if (neg-num? V4269) true (if (expr-has-neg-power? V4268) true (expr-has-neg-power? V4269)))) + +(defun expr-any-neg-power? (V4270) (cond ((= () V4270) false) ((cons? V4270) (if (expr-has-neg-power? (hd V4270)) true (expr-any-neg-power? (tl V4270)))) (true (simple-error "partial function expr-any-neg-power?")))) + +(defun neg-num? (V4273) (cond ((and (cons? V4273) (and (= int (hd V4273)) (and (cons? (tl V4273)) (and (= () (tl (tl V4273))) (number? (hd (tl V4273))))))) (< (hd (tl V4273)) 0)) ((and (cons? V4273) (and (= rat (hd V4273)) (and (cons? (tl V4273)) (and (cons? (tl (tl V4273))) (and (= () (tl (tl (tl V4273)))) (and (number? (hd (tl V4273))) (number? (hd (tl (tl V4273)))))))))) (< (hd (tl V4273)) 0)) (true false))) + +(defun factor-base-exp (V4274) (cond ((and (cons? V4274) (and (= int (hd V4274)) (and (cons? (tl V4274)) (= () (tl (tl V4274)))))) (cons V4274 (cons (cons int (cons 1 ())) ()))) ((and (cons? V4274) (and (= rat (hd V4274)) (and (cons? (tl V4274)) (and (cons? (tl (tl V4274))) (= () (tl (tl (tl V4274)))))))) (cons V4274 (cons (cons int (cons 1 ())) ()))) ((and (cons? V4274) (and (cons? (tl V4274)) (and (cons? (tl (tl V4274))) (= () (tl (tl (tl V4274))))))) (if (and (power-head? (hd V4274)) (number-expr? (hd (tl (tl V4274))))) (tl V4274) (cons V4274 (cons (cons int (cons 1 ())) ())))) (true (cons V4274 (cons (cons int (cons 1 ())) ()))))) + +(defun times-groups (V4275 V4276) (cond ((= () V4275) V4276) ((cons? V4275) (times-groups (tl V4275) (times-add-group (factor-base-exp (hd V4275)) V4276))) (true (simple-error "partial function times-groups")))) + +(defun times-add-group (V4277 V4278) (cond ((and (cons? V4277) (and (cons? (tl V4277)) (and (= () (tl (tl V4277))) (= () V4278)))) (cons V4277 ())) ((and (cons? V4277) (and (cons? (tl V4277)) (and (= () (tl (tl V4277))) (and (cons? V4278) (and (cons? (hd V4278)) (and (cons? (tl (hd V4278))) (= () (tl (tl (hd V4278)))))))))) (if (content-eq (hd V4277) (hd (hd V4278))) (cons (cons (hd (hd V4278)) (cons (num-add (hd (tl V4277)) (hd (tl (hd V4278)))) ())) (tl V4278)) (cons (hd V4278) (times-add-group V4277 (tl V4278))))) (true (simple-error "partial function times-add-group")))) + +(defun group->factor (V4279) (cond ((and (cons? V4279) (and (cons? (tl V4279)) (= () (tl (tl V4279))))) (if (num-eq? (hd (tl V4279)) (cons int (cons 1 ()))) (hd V4279) (cons (ct-power) V4279))) (true (simple-error "partial function group->factor")))) + +(defun split-num-factors (V4280 V4281 V4282) (cond ((= () V4280) (cons V4281 (cons (reverse V4282) ()))) ((cons? V4280) (if (number-expr? (hd V4280)) (split-num-factors (tl V4280) (num-mul V4281 (hd V4280)) V4282) (split-num-factors (tl V4280) V4281 (cons (hd V4280) V4282)))) (true (simple-error "partial function split-num-factors")))) + +(defun flatten-times-args (V4283) (cond ((= () V4283) ()) ((cons? V4283) (append (flatten-times-arg (hd V4283)) (flatten-times-args (tl V4283)))) (true (simple-error "partial function flatten-times-args")))) + +(defun flatten-times-arg (V4284) (cond ((and (cons? V4284) (times-head? (hd V4284))) (flatten-times-args (tl V4284))) (true (cons V4284 ())))) + +(defun collect-times (V4285) (let W4286 (flatten-times-args V4285) (let W4287 (split-num-factors W4286 (cons int (cons 1 ())) ()) (let W4288 (hd W4287) (let W4289 (hd (tl W4287)) (let W4290 (times-groups W4289 ()) (let W4291 (map (lambda Z4292 (group->factor Z4292)) W4290) (collect-times-rebuild W4288 W4291)))))))) + +(defun collect-times-rebuild (V4293 V4294) (if (num-eq? V4293 (cons int (cons 0 ()))) (cons int (cons 0 ())) (if (num-eq? V4293 (cons int (cons 1 ()))) (rebuild-nary (ct-times) V4294 (cons int (cons 1 ()))) (rebuild-nary (ct-times) (cons V4293 V4294) (cons int (cons 1 ())))))) + +(defun rebuild-nary (V4299 V4300 V4301) (cond ((= () V4300) V4301) ((and (cons? V4300) (= () (tl V4300))) (hd V4300)) (true (cons V4299 V4300)))) + +(defun ibp-max-depth () 3) + +(defun ibp-antideriv (V4308 V4309 V4310) (cond ((and (cons? V4308) (and (= sym (hd V4308)) (and (cons? (tl V4308)) (and (= () (tl (tl V4308))) (and (cons? V4310) (= () (tl V4310))))))) (ibp-antideriv-by-name (str (hd (tl V4308))) V4309 (hd V4310))) (true (cons none ())))) + +(defun ibp-antideriv-by-name (V4317 V4318 V4319) (cond ((= "Sin" V4317) (if (content-eq V4319 V4318) (cons some (cons (cons (ct-times) (cons (cons int (cons -1 ())) (cons (cons (cons sym (cons Cos ())) (cons V4319 ())) ()))) ())) (cons none ()))) ((= "Cos" V4317) (if (content-eq V4319 V4318) (cons some (cons (cons (cons sym (cons Sin ())) (cons V4319 ())) ())) (cons none ()))) ((= "Exp" V4317) (if (content-eq V4319 V4318) (cons some (cons (cons (cons sym (cons Exp ())) (cons V4319 ())) ())) (cons none ()))) (true (cons none ())))) + +(defun ibp-split-product (V4320 V4321) (ibp-split-loop V4320 V4321 ())) + +(defun ibp-split-loop (V4324 V4325 V4326) (cond ((= () V4325) (cons none ())) ((cons? V4325) (if (ibp-g-factor? V4324 (hd V4325)) (cons some (cons (cons (hd V4325) (cons (append (reverse V4326) (tl V4325)) ())) ())) (ibp-split-loop V4324 (tl V4325) (cons (hd V4325) V4326)))) (true (simple-error "partial function ibp-split-loop")))) + +(defun ibp-g-factor? (V4331 V4332) (cond ((and (cons? V4332) (and (cons? (hd V4332)) (and (= sym (hd (hd V4332))) (and (cons? (tl (hd V4332))) (and (= () (tl (tl (hd V4332)))) (and (cons? (tl V4332)) (= () (tl (tl V4332))))))))) (and (ibp-table-name? (str (hd (tl (hd V4332))))) (content-eq (hd (tl V4332)) V4331))) (true false))) + +(defun ibp-table-name? (V4335) (cond ((= "Sin" V4335) true) ((= "Cos" V4335) true) ((= "Exp" V4335) true) (true false))) + +(defun poly-in-var? (V4345 V4346) (cond ((= V4345 V4346) true) ((and (cons? V4346) (and (= int (hd V4346)) (and (cons? (tl V4346)) (= () (tl (tl V4346)))))) true) ((and (cons? V4346) (and (= rat (hd V4346)) (and (cons? (tl V4346)) (and (cons? (tl (tl V4346))) (= () (tl (tl (tl V4346)))))))) true) ((and (cons? V4346) (and (cons? (hd V4346)) (and (= sym (hd (hd V4346))) (and (cons? (tl (hd V4346))) (and (= () (tl (tl (hd V4346)))) (and (cons? (tl V4346)) (and (cons? (tl (tl V4346))) (and (= () (tl (tl (tl V4346)))) (= (str (hd (tl (hd V4346)))) "Power"))))))))) (and (power-head? (hd V4346)) (and (content-eq (hd (tl V4346)) V4345) (number-expr? (hd (tl (tl V4346))))))) ((and (cons? V4346) (and (cons? (hd V4346)) (and (= sym (hd (hd V4346))) (and (cons? (tl (hd V4346))) (and (= () (tl (tl (hd V4346)))) (or (= (str (hd (tl (hd V4346)))) "Times") (= (str (hd (tl (hd V4346)))) "Plus"))))))) (poly-args? V4345 (tl V4346))) (true false))) + +(defun poly-args? (V4347 V4348) (cond ((= () V4348) true) ((cons? V4348) (if (poly-in-var? V4347 (hd V4348)) (poly-args? V4347 (tl V4348)) false)) (true (simple-error "partial function poly-args?")))) + +(defun ibp-times (V4349) (cond ((= () V4349) (cons int (cons 1 ()))) ((and (cons? V4349) (= () (tl V4349))) (hd V4349)) (true (cons (ct-times) V4349)))) + +(defun ibp-integrate (V4350 V4351) (cons (cons sym (cons Integrate ())) (cons V4350 (cons V4351 ())))) + +(defun has-integrate-head? (V4360) (cond ((and (cons? V4360) (and (= sym (hd V4360)) (and (cons? (tl V4360)) (= () (tl (tl V4360)))))) false) ((and (cons? V4360) (and (= int (hd V4360)) (and (cons? (tl V4360)) (= () (tl (tl V4360)))))) false) ((and (cons? V4360) (and (= rat (hd V4360)) (and (cons? (tl V4360)) (and (cons? (tl (tl V4360))) (= () (tl (tl (tl V4360)))))))) false) ((and (cons? V4360) (and (cons? (hd V4360)) (and (= sym (hd (hd V4360))) (and (cons? (tl (hd V4360))) (= () (tl (tl (hd V4360)))))))) (if (= (str (hd (tl (hd V4360)))) "Integrate") true (has-integrate-list? (tl V4360)))) ((cons? V4360) (if (has-integrate-head? (hd V4360)) true (has-integrate-list? (tl V4360)))) (true false))) + +(defun has-integrate-list? (V4361) (cond ((= () V4361) false) ((cons? V4361) (if (has-integrate-head? (hd V4361)) true (has-integrate-list? (tl V4361)))) (true (simple-error "partial function has-integrate-list?")))) + +(defun integrate-by-parts (V4362 V4363) (ibp-attempt V4362 V4363 (ibp-max-depth))) + +(defun ibp-attempt (V4364 V4365 V4366) (cond ((= 0 V4366) (cons none ())) (true (ibp-on-form V4364 V4365 V4366)))) + +(defun ibp-on-form (V4373 V4374 V4375) (cond ((and (cons? V4373) (and (cons? (hd V4373)) (and (= sym (hd (hd V4373))) (and (cons? (tl (hd V4373))) (= () (tl (tl (hd V4373)))))))) (ibp-with-split (str (hd (tl (hd V4373)))) (tl V4373) V4374 V4375)) (true (cons none ())))) + +(defun ibp-with-split (V4384 V4385 V4386 V4387) (cond ((= "Times" V4384) (ibp-dispatch-split (ibp-split-product V4386 V4385) V4386 V4387)) (true (cons none ())))) + +(defun ibp-dispatch-split (V4392 V4393 V4394) (cond ((and (cons? V4392) (and (= none (hd V4392)) (= () (tl V4392)))) V4392) ((and (cons? V4392) (and (= some (hd V4392)) (and (cons? (tl V4392)) (and (cons? (hd (tl V4392))) (and (cons? (tl (hd (tl V4392)))) (and (= () (tl (tl (hd (tl V4392))))) (= () (tl (tl V4392))))))))) (let W4395 (ibp-times (hd (tl (hd (tl V4392))))) (if (poly-in-var? V4393 W4395) (ibp-go W4395 (hd (hd (tl V4392))) V4393 V4394) (cons none ())))) (true (simple-error "partial function ibp-dispatch-split")))) + +(defun ibp-go (V4404 V4405 V4406 V4407) (cond ((and (cons? V4405) (and (cons? (tl V4405)) (= () (tl (tl V4405))))) (ibp-build V4404 (ibp-antideriv (hd V4405) V4406 (tl V4405)) V4406 V4407)) (true (cons none ())))) + +(defun ibp-build (V4408 V4409 V4410 V4411) (cond ((and (cons? V4409) (and (= none (hd V4409)) (= () (tl V4409)))) V4409) ((and (cons? V4409) (and (= some (hd V4409)) (and (cons? (tl V4409)) (= () (tl (tl V4409)))))) (let W4412 (cons (cons sym (cons D ())) (cons V4408 (cons V4410 ()))) (let W4413 (cons (ct-times) (cons (hd (tl V4409)) (cons W4412 ()))) (let W4414 (normal-form (ibp-integrate W4413 V4410)) (if (has-integrate-head? W4414) (cons none ()) (cons some (cons (collect-like-terms (normal-form (cons (ct-plus) (cons (cons (ct-times) (cons V4408 (tl V4409))) (cons (cons (ct-times) (cons (cons int (cons -1 ())) (cons W4414 ()))) ()))))) ()))))))) (true (simple-error "partial function ibp-build")))) + +(defun integ-diffback-ok? (V4415 V4416 V4417) (content-eq (reduce (cons (cons sym (cons Simplify ())) (cons (cons (ct-plus) (cons (cons (cons sym (cons D ())) (cons V4415 (cons V4417 ()))) (cons (cons (ct-times) (cons (cons int (cons -1 ())) (cons V4416 ()))) ()))) ()))) (cons int (cons 0 ())))) + +(defun integrate-invfun (V4422 V4423) (cond ((and (cons? V4422) (and (cons? (hd V4422)) (and (= sym (hd (hd V4422))) (and (cons? (tl (hd V4422))) (and (= () (tl (tl (hd V4422)))) (and (cons? (tl V4422)) (= () (tl (tl V4422))))))))) (iv-by-name (str (hd (tl (hd V4422)))) (hd (tl V4422)) V4423)) (true (cons none ())))) + +(defun iv-by-name (V4430 V4431 V4432) (cond ((and (= "ArcTan" V4430) (content-eq V4431 V4432)) (iv-commit (iv-candidate "ArcTan" V4432) (cons (cons sym (cons ArcTan ())) (cons V4431 ())) V4432)) ((and (= "ArcSin" V4430) (content-eq V4431 V4432)) (iv-commit (iv-candidate "ArcSin" V4432) (cons (cons sym (cons ArcSin ())) (cons V4431 ())) V4432)) (true (cons none ())))) + +(defun iv-candidate (V4433 V4434) (cond ((= "ArcTan" V4433) (cons (ct-plus) (cons (cons (ct-times) (cons V4434 (cons (cons (cons sym (cons ArcTan ())) (cons V4434 ())) ()))) (cons (cons (ct-times) (cons (cons rat (cons -1 (cons 2 ()))) (cons (cons (cons sym (cons Log ())) (cons (cons (ct-plus) (cons (cons int (cons 1 ())) (cons (cons (ct-power) (cons V4434 (cons (cons int (cons 2 ())) ()))) ()))) ())) ()))) ())))) ((= "ArcSin" V4433) (cons (ct-plus) (cons (cons (ct-times) (cons V4434 (cons (cons (cons sym (cons ArcSin ())) (cons V4434 ())) ()))) (cons (cons (ct-power) (cons (cons (ct-plus) (cons (cons int (cons 1 ())) (cons (cons (ct-times) (cons (cons int (cons -1 ())) (cons (cons (ct-power) (cons V4434 (cons (cons int (cons 2 ())) ()))) ()))) ()))) (cons (cons rat (cons 1 (cons 2 ()))) ()))) ())))) (true (simple-error "partial function iv-candidate")))) + +(defun iv-commit (V4435 V4436 V4437) (if (integ-diffback-ok? V4435 V4436 V4437) (cons some (cons V4435 ())) (cons none ()))) + +(defun integrate-log-parts (V4438 V4439) (if (ilog-log-of-var? V4439 V4438) (ilog-emit V4439 (cons int (cons 0 ()))) (ilog-on-form V4438 V4439))) + +(defun ilog-log-of-var? (V4442 V4443) (cond ((and (cons? V4443) (and (cons? (hd V4443)) (and (= sym (hd (hd V4443))) (and (cons? (tl (hd V4443))) (and (= () (tl (tl (hd V4443)))) (and (cons? (tl V4443)) (= () (tl (tl V4443))))))))) (if (= (str (hd (tl (hd V4443)))) "Log") (content-eq (hd (tl V4443)) V4442) false)) (true false))) + +(defun ilog-on-form (V4448 V4449) (cond ((and (cons? V4448) (and (cons? (hd V4448)) (and (= sym (hd (hd V4448))) (and (cons? (tl (hd V4448))) (= () (tl (tl (hd V4448)))))))) (ilog-on-times (str (hd (tl (hd V4448)))) (tl V4448) V4449)) (true (cons none ())))) + +(defun ilog-on-times (V4456 V4457 V4458) (cond ((= "Times" V4456) (ilog-find-log V4457 V4458 ())) (true (cons none ())))) + +(defun ilog-find-log (V4463 V4464 V4465) (cond ((= () V4463) (cons none ())) ((cons? V4463) (if (ilog-log-of-var? V4464 (hd V4463)) (ilog-rest-exp (append (reverse V4465) (tl V4463)) V4464) (ilog-find-log (tl V4463) V4464 (cons (hd V4463) V4465)))) (true (simple-error "partial function ilog-find-log")))) + +(defun ilog-rest-exp (V4470 V4471) (cond ((and (cons? V4470) (= () (tl V4470))) (ilog-rest-exp-1 (hd V4470) V4471)) (true (cons none ())))) + +(defun ilog-rest-exp-1 (V4472 V4473) (cond ((and (cons? V4472) (and (cons? (hd V4472)) (and (= sym (hd (hd V4472))) (and (cons? (tl (hd V4472))) (and (= () (tl (tl (hd V4472)))) (and (cons? (tl V4472)) (and (cons? (tl (tl V4472))) (= () (tl (tl (tl V4472))))))))))) (ilog-rest-power (str (hd (tl (hd V4472)))) (hd (tl V4472)) (hd (tl (tl V4472))) V4473)) (true (if (content-eq V4472 V4473) (ilog-emit V4473 (cons int (cons 1 ()))) (cons none ()))))) + +(defun ilog-rest-power (V4482 V4483 V4484 V4485) (cond ((= "Power" V4482) (if (content-eq V4483 V4485) (if (number-expr? V4484) (ilog-emit V4485 V4484) (cons none ())) (cons none ()))) (true (cons none ())))) + +(defun ilog-integrand (V4486 V4487) (cond ((and (cons? V4487) (and (= int (hd V4487)) (and (cons? (tl V4487)) (and (= 0 (hd (tl V4487))) (= () (tl (tl V4487))))))) (cons (cons sym (cons Log ())) (cons V4486 ()))) (true (cons (ct-times) (cons (cons (ct-power) (cons V4486 (cons V4487 ()))) (cons (cons (cons sym (cons Log ())) (cons V4486 ())) ())))))) + +(defun ilog-emit (V4488 V4489) (ilog-build V4488 V4489 (num-add V4489 (cons int (cons 1 ()))))) + +(defun ilog-build (V4490 V4491 V4492) (if (num-eq? V4492 (cons int (cons 0 ()))) (cons none ()) (let W4493 (cons (ct-plus) (cons (cons (ct-times) (cons (num-div (cons int (cons 1 ())) V4492) (cons (cons (ct-power) (cons V4490 (cons V4492 ()))) (cons (cons (cons sym (cons Log ())) (cons V4490 ())) ())))) (cons (cons (ct-times) (cons (cons int (cons -1 ())) (cons (num-div (cons int (cons 1 ())) (num-mul V4492 V4492)) (cons (cons (ct-power) (cons V4490 (cons V4492 ()))) ())))) ()))) (if (integ-diffback-ok? W4493 (ilog-integrand V4490 V4491) V4490) (cons some (cons W4493 ())) (cons none ()))))) + +(defun integrate-cyclic (V4498 V4499) (cond ((and (cons? V4498) (and (cons? (hd V4498)) (and (= sym (hd (hd V4498))) (and (cons? (tl (hd V4498))) (and (= () (tl (tl (hd V4498)))) (and (cons? (tl V4498)) (and (cons? (tl (tl V4498))) (= () (tl (tl (tl V4498))))))))))) (icyc-times (str (hd (tl (hd V4498)))) (hd (tl V4498)) (hd (tl (tl V4498))) V4499)) (true (cons none ())))) + +(defun icyc-times (V4508 V4509 V4510 V4511) (cond ((= "Times" V4508) (icyc-pair V4509 V4510 V4511)) (true (cons none ())))) + +(defun icyc-pair (V4512 V4513 V4514) (if (icyc-exp? V4512 V4514) (icyc-emit (icyc-trig-name V4513 V4514) V4514 V4513) (if (icyc-exp? V4513 V4514) (icyc-emit (icyc-trig-name V4512 V4514) V4514 V4512) (cons none ())))) + +(defun icyc-exp? (V4519 V4520) (cond ((and (cons? V4519) (and (cons? (hd V4519)) (and (= sym (hd (hd V4519))) (and (cons? (tl (hd V4519))) (and (= () (tl (tl (hd V4519)))) (and (cons? (tl V4519)) (= () (tl (tl V4519))))))))) (if (= (str (hd (tl (hd V4519)))) "Exp") (content-eq (hd (tl V4519)) V4520) false)) (true false))) + +(defun icyc-trig-name (V4525 V4526) (cond ((and (cons? V4525) (and (cons? (hd V4525)) (and (= sym (hd (hd V4525))) (and (cons? (tl (hd V4525))) (and (= () (tl (tl (hd V4525)))) (and (cons? (tl V4525)) (= () (tl (tl V4525))))))))) (icyc-trig-name-2 (str (hd (tl (hd V4525)))) (hd (tl V4525)) V4526)) (true ""))) + +(defun icyc-trig-name-2 (V4533 V4534 V4535) (cond ((= "Sin" V4533) (if (content-eq V4534 V4535) "Sin" "")) ((= "Cos" V4533) (if (content-eq V4534 V4535) "Cos" "")) (true ""))) + +(defun icyc-emit (V4542 V4543 V4544) (cond ((= "Sin" V4542) (icyc-gate (cons (ct-times) (cons (cons rat (cons 1 (cons 2 ()))) (cons (cons (cons sym (cons Exp ())) (cons V4543 ())) (cons (cons (ct-plus) (cons (cons (cons sym (cons Sin ())) (cons V4543 ())) (cons (cons (ct-times) (cons (cons int (cons -1 ())) (cons (cons (cons sym (cons Cos ())) (cons V4543 ())) ()))) ()))) ())))) (cons (ct-times) (cons (cons (cons sym (cons Exp ())) (cons V4543 ())) (cons V4544 ()))) V4543)) ((= "Cos" V4542) (icyc-gate (cons (ct-times) (cons (cons rat (cons 1 (cons 2 ()))) (cons (cons (cons sym (cons Exp ())) (cons V4543 ())) (cons (cons (ct-plus) (cons (cons (cons sym (cons Sin ())) (cons V4543 ())) (cons (cons (cons sym (cons Cos ())) (cons V4543 ())) ()))) ())))) (cons (ct-times) (cons (cons (cons sym (cons Exp ())) (cons V4543 ())) (cons V4544 ()))) V4543)) (true (cons none ())))) + +(defun icyc-gate (V4545 V4546 V4547) (if (integ-diffback-ok? V4545 V4546 V4547) (cons some (cons V4545 ())) (cons none ()))) + +(defun integrate-trigpow (V4552 V4553) (cond ((and (cons? V4552) (and (cons? (hd V4552)) (and (= sym (hd (hd V4552))) (and (cons? (tl (hd V4552))) (and (= () (tl (tl (hd V4552)))) (and (cons? (tl V4552)) (and (cons? (hd (tl V4552))) (and (cons? (hd (hd (tl V4552)))) (and (= sym (hd (hd (hd (tl V4552))))) (and (cons? (tl (hd (hd (tl V4552))))) (and (= () (tl (tl (hd (hd (tl V4552)))))) (and (cons? (tl (hd (tl V4552)))) (and (= () (tl (tl (hd (tl V4552))))) (and (cons? (tl (tl V4552))) (= () (tl (tl (tl V4552)))))))))))))))))) (itp-power (str (hd (tl (hd V4552)))) (str (hd (tl (hd (hd (tl V4552)))))) (hd (tl (hd (tl V4552)))) (hd (tl (tl V4552))) V4553)) (true (cons none ())))) + +(defun itp-power (V4564 V4565 V4566 V4567 V4568) (cond ((= "Power" V4564) (if (content-eq V4566 V4568) (if (number-expr? V4567) (if (num-eq? V4567 (cons int (cons 2 ()))) (itp-emit V4565 V4568) (cons none ())) (cons none ())) (cons none ()))) (true (cons none ())))) + +(defun itp-emit (V4573 V4574) (cond ((= "Cos" V4573) (itp-gate (itp-half-plus V4574 (cons int (cons 1 ()))) (cons (ct-power) (cons (cons (cons sym (cons Cos ())) (cons V4574 ())) (cons (cons int (cons 2 ())) ()))) V4574)) ((= "Sin" V4573) (itp-gate (itp-half-plus V4574 (cons int (cons -1 ()))) (cons (ct-power) (cons (cons (cons sym (cons Sin ())) (cons V4574 ())) (cons (cons int (cons 2 ())) ()))) V4574)) ((= "Sec" V4573) (itp-gate (cons (cons sym (cons Tan ())) (cons V4574 ())) (cons (ct-power) (cons (cons (cons sym (cons Sec ())) (cons V4574 ())) (cons (cons int (cons 2 ())) ()))) V4574)) (true (cons none ())))) + +(defun itp-half-plus (V4575 V4576) (cons (ct-plus) (cons (cons (ct-times) (cons (cons rat (cons 1 (cons 2 ()))) (cons V4575 ()))) (cons (cons (ct-times) (cons (cons rat (cons 1 (cons 2 ()))) (cons V4576 (cons (cons (cons sym (cons Sin ())) (cons V4575 ())) (cons (cons (cons sym (cons Cos ())) (cons V4575 ())) ()))))) ())))) + +(defun itp-gate (V4577 V4578 V4579) (if (integ-diffback-ok? V4577 V4578 V4579) (cons some (cons V4577 ())) (cons none ()))) + +(defun ct-divide () (cons sym (cons Divide ()))) + +(defun integrate-sincos (V4584 V4585) (cond ((and (cons? V4584) (and (cons? (hd V4584)) (and (= sym (hd (hd V4584))) (and (cons? (tl (hd V4584))) (and (= () (tl (tl (hd V4584)))) (and (cons? (tl V4584)) (and (cons? (tl (tl V4584))) (= () (tl (tl (tl V4584))))))))))) (isc-times (str (hd (tl (hd V4584)))) (hd (tl V4584)) (hd (tl (tl V4584))) V4585)) (true (cons none ())))) + +(defun isc-times (V4594 V4595 V4596 V4597) (cond ((= "Times" V4594) (isc-pair V4595 V4596 V4597)) (true (cons none ())))) + +(defun isc-pair (V4598 V4599 V4600) (if (isc-is? "Sin" V4598 V4600) (if (isc-is? "Cos" V4599 V4600) (isc-emit V4600) (cons none ())) (if (isc-is? "Cos" V4598 V4600) (if (isc-is? "Sin" V4599 V4600) (isc-emit V4600) (cons none ())) (cons none ())))) + +(defun isc-is? (V4605 V4606 V4607) (cond ((and (cons? V4606) (and (cons? (hd V4606)) (and (= sym (hd (hd V4606))) (and (cons? (tl (hd V4606))) (and (= () (tl (tl (hd V4606)))) (and (cons? (tl V4606)) (= () (tl (tl V4606))))))))) (if (= (str (hd (tl (hd V4606)))) V4605) (content-eq (hd (tl V4606)) V4607) false)) (true false))) + +(defun isc-emit (V4608) (let W4609 (cons (ct-times) (cons (cons rat (cons 1 (cons 2 ()))) (cons (cons (ct-power) (cons (cons (cons sym (cons Sin ())) (cons V4608 ())) (cons (cons int (cons 2 ())) ()))) ()))) (let W4610 (cons (ct-times) (cons (cons (cons sym (cons Sin ())) (cons V4608 ())) (cons (cons (cons sym (cons Cos ())) (cons V4608 ())) ()))) (if (integ-diffback-ok? W4609 W4610 V4608) (cons some (cons W4609 ())) (cons none ()))))) + +(defun integrate-powusub (V4615 V4616) (cond ((and (cons? V4615) (and (cons? (hd V4615)) (and (= sym (hd (hd V4615))) (and (cons? (tl (hd V4615))) (and (= () (tl (tl (hd V4615)))) (and (cons? (tl V4615)) (and (cons? (tl (tl V4615))) (= () (tl (tl (tl V4615))))))))))) (ipow-by-head (str (hd (tl (hd V4615)))) (hd (tl V4615)) (hd (tl (tl V4615))) V4615 V4616)) (true (cons none ())))) + +(defun ipow-by-head (V4627 V4628 V4629 V4630 V4631) (cond ((= "Power" V4627) (if (number-expr? V4629) (ipow-on (expr->coeffs V4631 V4628) V4629 V4628 V4630 V4631) (cons none ()))) ((= "Divide" V4627) (ipow-div V4628 V4629 V4630 V4631)) (true (cons none ())))) + +(defun ipow-div (V4640 V4641 V4642 V4643) (cond ((and (cons? V4640) (and (= int (hd V4640)) (and (cons? (tl V4640)) (and (= 1 (hd (tl V4640))) (and (= () (tl (tl V4640))) (and (cons? V4641) (and (cons? (hd V4641)) (and (= sym (hd (hd V4641))) (and (cons? (tl (hd V4641))) (and (= () (tl (tl (hd V4641)))) (and (cons? (tl V4641)) (and (cons? (tl (tl V4641))) (= () (tl (tl (tl V4641)))))))))))))))) (ipow-div-2 (str (hd (tl (hd V4641)))) (hd (tl V4641)) (hd (tl (tl V4641))) V4642 V4643)) (true (cons none ())))) + +(defun ipow-div-2 (V4654 V4655 V4656 V4657 V4658) (cond ((= "Power" V4654) (if (number-expr? V4656) (ipow-on (expr->coeffs V4658 V4655) (num-mul (cons int (cons -1 ())) V4656) V4655 V4657 V4658) (cons none ()))) (true (cons none ())))) + +(defun ipow-on (V4669 V4670 V4671 V4672 V4673) (cond ((and (cons? V4669) (and (= some (hd V4669)) (and (cons? (tl V4669)) (and (cons? (hd (tl V4669))) (and (cons? (tl (hd (tl V4669)))) (and (= () (tl (tl (hd (tl V4669))))) (= () (tl (tl V4669))))))))) (ipow-emit (hd (tl (hd (tl V4669)))) V4670 V4671 V4672 V4673)) (true (cons none ())))) + +(defun ipow-emit (V4674 V4675 V4676 V4677 V4678) (ipow-np1 V4674 (num-add V4675 (cons int (cons 1 ()))) V4676 V4677 V4678)) + +(defun ipow-np1 (V4679 V4680 V4681 V4682 V4683) (if (num-eq? V4680 (cons int (cons 0 ()))) (cons none ()) (ipow-gate (cons (ct-times) (cons (num-div (cons int (cons 1 ())) (num-mul V4679 V4680)) (cons (cons (ct-power) (cons V4681 (cons V4680 ()))) ()))) V4682 V4683))) + +(defun ipow-gate (V4684 V4685 V4686) (if (integ-diffback-ok? V4684 V4685 V4686) (cons some (cons V4684 ())) (cons none ()))) + +(defun integrate-arcsin (V4691 V4692) (cond ((and (cons? V4691) (and (cons? (hd V4691)) (and (= sym (hd (hd V4691))) (and (cons? (tl (hd V4691))) (and (= () (tl (tl (hd V4691)))) (and (cons? (tl V4691)) (and (cons? (tl (tl V4691))) (= () (tl (tl (tl V4691))))))))))) (iasin-div (str (hd (tl (hd V4691)))) (hd (tl V4691)) (hd (tl (tl V4691))) V4692)) (true (cons none ())))) + +(defun iasin-div (V4701 V4702 V4703 V4704) (cond ((and (= "Divide" V4701) (and (cons? V4702) (and (= int (hd V4702)) (and (cons? (tl V4702)) (and (= 1 (hd (tl V4702))) (= () (tl (tl V4702)))))))) (iasin-den V4703 V4704)) (true (cons none ())))) + +(defun iasin-den (V4709 V4710) (cond ((and (cons? V4709) (and (cons? (hd V4709)) (and (= sym (hd (hd V4709))) (and (cons? (tl (hd V4709))) (and (= () (tl (tl (hd V4709)))) (and (cons? (tl V4709)) (and (cons? (tl (tl V4709))) (= () (tl (tl (tl V4709))))))))))) (iasin-sqrt (str (hd (tl (hd V4709)))) (hd (tl V4709)) (hd (tl (tl V4709))) V4710)) (true (cons none ())))) + +(defun iasin-sqrt (V4719 V4720 V4721 V4722) (cond ((and (= "Power" V4719) (and (cons? V4721) (and (= rat (hd V4721)) (and (cons? (tl V4721)) (and (= 1 (hd (tl V4721))) (and (cons? (tl (tl V4721))) (and (= 2 (hd (tl (tl V4721)))) (= () (tl (tl (tl V4721))))))))))) (iasin-on (expr->coeffs V4722 V4720) V4720 V4722)) (true (cons none ())))) + +(defun iasin-on (V4729 V4730 V4731) (cond ((and (cons? V4729) (and (= some (hd V4729)) (and (cons? (tl V4729)) (and (cons? (hd (tl V4729))) (and (cons? (tl (hd (tl V4729)))) (and (cons? (tl (tl (hd (tl V4729))))) (and (= () (tl (tl (tl (hd (tl V4729)))))) (= () (tl (tl V4729)))))))))) (if (one-minus-xsq? (hd (hd (tl V4729))) (hd (tl (hd (tl V4729)))) (hd (tl (tl (hd (tl V4729)))))) (iasin-gate V4730 V4731) (cons none ()))) (true (cons none ())))) + +(defun one-minus-xsq? (V4732 V4733 V4734) (if (content-eq V4732 (cons int (cons 1 ()))) (if (content-eq V4733 (cons int (cons 0 ()))) (content-eq V4734 (cons int (cons -1 ()))) false) false)) + +(defun iasin-gate (V4735 V4736) (let W4737 (cons (cons sym (cons ArcSin ())) (cons V4736 ())) (let W4738 (cons (ct-divide) (cons (cons int (cons 1 ())) (cons (cons (ct-power) (cons V4735 (cons (cons rat (cons 1 (cons 2 ()))) ()))) ()))) (if (integ-diffback-ok? W4737 W4738 V4736) (cons some (cons W4737 ())) (cons none ()))))) + +(pr "calc-helpers.shen loaded (SameQ/UnsameQ/FreeQ/NumberQ/Positive/And/Simplify + free-of? + collect-like-terms + integrate-by-parts). +" (stoutput)) + +(defun poly-plus-head? (V4741) (cond ((and (cons? V4741) (and (= sym (hd V4741)) (and (cons? (tl V4741)) (= () (tl (tl V4741)))))) (= (str (hd (tl V4741))) "Plus")) (true false))) + +(defun poly-times-head? (V4744) (cond ((and (cons? V4744) (and (= sym (hd V4744)) (and (cons? (tl V4744)) (= () (tl (tl V4744)))))) (= (str (hd (tl V4744))) "Times")) (true false))) + +(defun poly-power-head? (V4747) (cond ((and (cons? V4747) (and (= sym (hd V4747)) (and (cons? (tl V4747)) (= () (tl (tl V4747)))))) (= (str (hd (tl V4747))) "Power")) (true false))) + +(defun poly-ct-plus () (cons sym (cons Plus ()))) + +(defun poly-ct-times () (cons sym (cons Times ()))) + +(defun poly-ct-power () (cons sym (cons Power ()))) + +(defun nonneg-int-exp? (V4750) (cond ((and (cons? V4750) (and (= int (hd V4750)) (and (cons? (tl V4750)) (= () (tl (tl V4750)))))) (>= (hd (tl V4750)) 0)) (true false))) + +(defun expr->poly (V4751) (if (numeric? V4751) (const-poly V4751) (poly-of-compound V4751))) + +(defun poly-of-compound (V4752) (cond ((cons? V4752) (poly-of-head (hd V4752) (tl V4752))) (true (gen-poly V4752)))) + +(defun poly-of-head (V4753 V4754) (if (poly-plus-head? V4753) (poly-sum-list V4754) (if (poly-times-head? V4753) (poly-prod-list V4754) (if (poly-power-head? V4753) (poly-of-power V4754 (cons V4753 V4754)) (gen-poly (cons V4753 V4754)))))) + +(defun poly-of-power (V4757 V4758) (cond ((and (cons? V4757) (and (cons? (tl V4757)) (= () (tl (tl V4757))))) (if (nonneg-int-exp? (hd (tl V4757))) (poly-pow (expr->poly (hd V4757)) (hd (tl (hd (tl V4757))))) (gen-poly V4758))) (true (gen-poly V4758)))) + +(defun poly-sum-list (V4759) (cond ((= () V4759) (zero-poly)) ((cons? V4759) (poly-add (expr->poly (hd V4759)) (poly-sum-list (tl V4759)))) (true (simple-error "partial function poly-sum-list")))) + +(defun poly-prod-list (V4760) (cond ((= () V4760) (one-poly)) ((cons? V4760) (poly-mul (expr->poly (hd V4760)) (poly-prod-list (tl V4760)))) (true (simple-error "partial function poly-prod-list")))) + +(defun zero-poly () ()) + +(defun one-poly () (cons (cons (cons int (cons 1 ())) (cons () ())) ())) + +(defun const-poly (V4761) (if (num-eq? V4761 (cons int (cons 0 ()))) () (cons (cons V4761 (cons () ())) ()))) + +(defun gen-poly (V4762) (cons (cons (cons int (cons 1 ())) (cons (cons (cons V4762 (cons (cons int (cons 1 ())) ())) ()) ())) ())) + +(defun term-coeff (V4765) (cond ((and (cons? V4765) (and (cons? (tl V4765)) (= () (tl (tl V4765))))) (hd V4765)) (true (simple-error "partial function term-coeff")))) + +(defun term-mono (V4768) (cond ((and (cons? V4768) (and (cons? (tl V4768)) (= () (tl (tl V4768))))) (hd (tl V4768))) (true (simple-error "partial function term-mono")))) + +(defun mono-mul (V4769 V4770) (cond ((= () V4769) V4770) ((= () V4770) V4769) ((and (cons? V4769) (and (cons? (hd V4769)) (and (cons? (tl (hd V4769))) (and (= () (tl (tl (hd V4769)))) (and (cons? V4770) (and (cons? (hd V4770)) (and (cons? (tl (hd V4770))) (= () (tl (tl (hd V4770))))))))))) (let W4771 (unwrap-ch (content-hash (hd (hd V4769)))) (let W4772 (unwrap-ch (content-hash (hd (hd V4770)))) (if (= W4771 W4772) (cons (cons (hd (hd V4769)) (cons (num-add (hd (tl (hd V4769))) (hd (tl (hd V4770)))) ())) (mono-mul (tl V4769) (tl V4770))) (if (< W4771 W4772) (cons (hd V4769) (mono-mul (tl V4769) V4770)) (cons (hd V4770) (mono-mul V4769 (tl V4770)))))))) (true (simple-error "partial function mono-mul")))) + +(defun poly-add (V4773 V4774) (canon-sort-poly (poly-add-raw V4773 V4774))) + +(defun poly-add-raw (V4775 V4776) (cond ((= () V4776) V4775) ((cons? V4776) (poly-add-raw (insert-term (hd V4776) V4775) (tl V4776))) (true (simple-error "partial function poly-add-raw")))) + +(defun insert-term (V4777 V4778) (cond ((and (cons? V4777) (and (cons? (tl V4777)) (and (= () (tl (tl V4777))) (= () V4778)))) (if (num-eq? (hd V4777) (cons int (cons 0 ()))) () (cons V4777 ()))) ((and (cons? V4777) (and (cons? (tl V4777)) (and (= () (tl (tl V4777))) (and (cons? V4778) (and (cons? (hd V4778)) (and (cons? (tl (hd V4778))) (= () (tl (tl (hd V4778)))))))))) (if (mono-eq? (hd (tl V4777)) (hd (tl (hd V4778)))) (let W4779 (num-add (hd V4777) (hd (hd V4778))) (if (num-eq? W4779 (cons int (cons 0 ()))) (tl V4778) (cons (cons W4779 (tl (hd V4778))) (tl V4778)))) (cons (hd V4778) (insert-term V4777 (tl V4778))))) (true (simple-error "partial function insert-term")))) + +(defun mono-eq? (V4784 V4785) (cond ((and (= () V4784) (= () V4785)) true) ((and (cons? V4784) (and (cons? (hd V4784)) (and (cons? (tl (hd V4784))) (and (= () (tl (tl (hd V4784)))) (and (cons? V4785) (and (cons? (hd V4785)) (and (cons? (tl (hd V4785))) (= () (tl (tl (hd V4785))))))))))) (if (content-eq (hd (hd V4784)) (hd (hd V4785))) (if (num-eq? (hd (tl (hd V4784))) (hd (tl (hd V4785)))) (mono-eq? (tl V4784) (tl V4785)) false) false)) (true false))) + +(defun poly-mul (V4790 V4791) (cond ((= () V4790) ()) ((= () V4791) ()) (true (canon-sort-poly (poly-mul-raw V4790 V4791 ()))))) + +(defun poly-mul-raw (V4794 V4795 V4796) (cond ((= () V4794) V4796) ((cons? V4794) (poly-mul-raw (tl V4794) V4795 (poly-add-raw V4796 (term-times-poly (hd V4794) V4795)))) (true (simple-error "partial function poly-mul-raw")))) + +(defun term-times-poly (V4799 V4800) (cond ((= () V4800) ()) ((and (cons? V4799) (and (cons? (tl V4799)) (and (= () (tl (tl V4799))) (and (cons? V4800) (and (cons? (hd V4800)) (and (cons? (tl (hd V4800))) (= () (tl (tl (hd V4800)))))))))) (cons (cons (num-mul (hd V4799) (hd (hd V4800))) (cons (mono-mul (hd (tl V4799)) (hd (tl (hd V4800)))) ())) (term-times-poly V4799 (tl V4800)))) (true (simple-error "partial function term-times-poly")))) + +(defun poly-pow (V4803 V4804) (cond ((= 0 V4804) (one-poly)) (true (poly-mul V4803 (poly-pow V4803 (- V4804 1)))))) + +(defun canon-sort-poly (V4805) (sort-terms V4805)) + +(defun sort-terms (V4806) (cond ((= () V4806) ()) ((cons? V4806) (insert-term-ordered (hd V4806) (sort-terms (tl V4806)))) (true (simple-error "partial function sort-terms")))) + +(defun insert-term-ordered (V4807 V4808) (cond ((= () V4808) (cons V4807 ())) ((cons? V4808) (if (term-before? V4807 (hd V4808)) (cons V4807 V4808) (cons (hd V4808) (insert-term-ordered V4807 (tl V4808))))) (true (simple-error "partial function insert-term-ordered")))) + +(defun mono-degree (V4813) (cond ((= () V4813) 0) ((and (cons? V4813) (and (cons? (hd V4813)) (and (cons? (tl (hd V4813))) (and (cons? (hd (tl (hd V4813)))) (and (= int (hd (hd (tl (hd V4813))))) (and (cons? (tl (hd (tl (hd V4813))))) (and (= () (tl (tl (hd (tl (hd V4813)))))) (= () (tl (tl (hd V4813))))))))))) (+ (hd (tl (hd (tl (hd V4813))))) (mono-degree (tl V4813)))) ((and (cons? V4813) (and (cons? (hd V4813)) (and (cons? (tl (hd V4813))) (= () (tl (tl (hd V4813))))))) (mono-degree (tl V4813))) (true (simple-error "partial function mono-degree")))) + +(defun term-before? (V4818 V4819) (cond ((and (cons? V4818) (and (cons? (tl V4818)) (and (= () (tl (tl V4818))) (and (cons? V4819) (and (cons? (tl V4819)) (= () (tl (tl V4819)))))))) (let W4820 (mono-degree (hd (tl V4818))) (let W4821 (mono-degree (hd (tl V4819))) (if (> W4820 W4821) true (if (< W4820 W4821) false (mono-lex-before? (hd (tl V4818)) (hd (tl V4819)))))))) (true (simple-error "partial function term-before?")))) + +(defun mono-lex-before? (V4826 V4827) (cond ((and (= () V4826) (= () V4827)) false) ((= () V4826) true) ((= () V4827) false) ((and (cons? V4826) (and (cons? (hd V4826)) (and (cons? (tl (hd V4826))) (and (= () (tl (tl (hd V4826)))) (and (cons? V4827) (and (cons? (hd V4827)) (and (cons? (tl (hd V4827))) (= () (tl (tl (hd V4827))))))))))) (let W4828 (unwrap-ch (content-hash (hd (hd V4826)))) (let W4829 (unwrap-ch (content-hash (hd (hd V4827)))) (if (< W4828 W4829) true (if (> W4828 W4829) false (let W4830 (exp-int (hd (tl (hd V4826)))) (let W4831 (exp-int (hd (tl (hd V4827)))) (if (< W4830 W4831) true (if (> W4830 W4831) false (mono-lex-before? (tl V4826) (tl V4827))))))))))) (true (simple-error "partial function mono-lex-before?")))) + +(defun exp-int (V4834) (cond ((and (cons? V4834) (and (= int (hd V4834)) (and (cons? (tl V4834)) (= () (tl (tl V4834)))))) (hd (tl V4834))) (true 0))) + +(defun poly->expr (V4835) (cond ((= () V4835) (cons int (cons 0 ()))) (true (terms->expr V4835)))) + +(defun terms->expr (V4836) (cond ((and (cons? V4836) (= () (tl V4836))) (term->expr (hd V4836))) (true (cons (poly-ct-plus) (map (lambda Z4837 (term->expr Z4837)) V4836))))) + +(defun term->expr (V4838) (cond ((and (cons? V4838) (and (cons? (tl V4838)) (and (= () (hd (tl V4838))) (= () (tl (tl V4838)))))) (hd V4838)) ((and (cons? V4838) (and (cons? (tl V4838)) (= () (tl (tl V4838))))) (let W4839 (mono->factors (hd (tl V4838))) (if (num-eq? (hd V4838) (cons int (cons 1 ()))) (factors->expr W4839) (factors->expr (cons (hd V4838) W4839))))) (true (simple-error "partial function term->expr")))) + +(defun mono->factors (V4840) (cond ((= () V4840) ()) ((and (cons? V4840) (and (cons? (hd V4840)) (and (cons? (tl (hd V4840))) (and (cons? (hd (tl (hd V4840)))) (and (= int (hd (hd (tl (hd V4840))))) (and (cons? (tl (hd (tl (hd V4840))))) (and (= 1 (hd (tl (hd (tl (hd V4840)))))) (and (= () (tl (tl (hd (tl (hd V4840)))))) (= () (tl (tl (hd V4840)))))))))))) (cons (hd (hd V4840)) (mono->factors (tl V4840)))) ((and (cons? V4840) (and (cons? (hd V4840)) (and (cons? (tl (hd V4840))) (= () (tl (tl (hd V4840))))))) (cons (cons (poly-ct-power) (hd V4840)) (mono->factors (tl V4840)))) (true (simple-error "partial function mono->factors")))) + +(defun factors->expr (V4841) (cond ((= () V4841) (cons int (cons 1 ()))) ((and (cons? V4841) (= () (tl V4841))) (hd V4841)) (true (cons (poly-ct-times) V4841)))) + +(defun poly-expand (V4842) (poly->expr (expr->poly V4842))) + +(defun polynomial-q? (V4843 V4844) (if (numeric? V4843) true (poly-q-nonnum V4843 V4844))) + +(defun poly-q-nonnum (V4845 V4846) (if (content-eq V4845 V4846) true (if (free-of? V4845 V4846) true (poly-q-structural V4845 V4846)))) + +(defun poly-q-structural (V4849 V4850) (cond ((cons? V4849) (poly-q-head (hd V4849) (tl V4849) V4850)) (true false))) + +(defun poly-q-head (V4851 V4852 V4853) (if (or (poly-plus-head? V4851) (poly-times-head? V4851)) (poly-q-args V4852 V4853) (if (poly-power-head? V4851) (poly-q-power V4852 V4853) false))) + +(defun poly-q-args (V4854 V4855) (cond ((= () V4854) true) ((cons? V4854) (if (polynomial-q? (hd V4854) V4855) (poly-q-args (tl V4854) V4855) false)) (true (simple-error "partial function poly-q-args")))) + +(defun poly-q-power (V4858 V4859) (cond ((and (cons? V4858) (and (cons? (tl V4858)) (= () (tl (tl V4858))))) (if (nonneg-int-exp? (hd (tl V4858))) (polynomial-q? (hd V4858) V4859) false)) (true false))) + +(pr "poly.shen loaded (expr<->poly, Expand + PolynomialQ). +" (stoutput)) + +(defun dedup-syms (V4860) (cond ((= () V4860) ()) ((cons? V4860) (if (element? (hd V4860) (dedup-syms (tl V4860))) (dedup-syms (tl V4860)) (cons (hd V4860) (dedup-syms (tl V4860))))) (true (simple-error "partial function dedup-syms")))) + +(defun indet-names (V4871) (cond ((and (cons? V4871) (and (= sym (hd V4871)) (and (cons? (tl V4871)) (= () (tl (tl V4871)))))) (tl V4871)) ((and (cons? V4871) (and (= int (hd V4871)) (and (cons? (tl V4871)) (= () (tl (tl V4871)))))) ()) ((and (cons? V4871) (and (= rat (hd V4871)) (and (cons? (tl V4871)) (and (cons? (tl (tl V4871))) (= () (tl (tl (tl V4871)))))))) ()) ((cons? V4871) (indet-names-list (tl V4871))) (true ()))) + +(defun indet-names-list (V4872) (cond ((= () V4872) ()) ((cons? V4872) (append (indet-names (hd V4872)) (indet-names-list (tl V4872)))) (true (simple-error "partial function indet-names-list")))) + +(defun free-sym-names (V4873) (dedup-syms (indet-names V4873))) + +(defun single-var (V4874) (let W4875 (free-sym-names V4874) (if (= (length W4875) 1) (cons some (cons (cons sym (cons (hd W4875) ())) ())) (cons none ())))) + +(defun term-exp-in (V4882 V4883) (cond ((and (cons? V4883) (and (cons? (tl V4883)) (and (= () (hd (tl V4883))) (= () (tl (tl V4883)))))) 0) ((and (cons? V4883) (and (cons? (tl V4883)) (and (cons? (hd (tl V4883))) (and (cons? (hd (hd (tl V4883)))) (and (cons? (tl (hd (hd (tl V4883))))) (and (cons? (hd (tl (hd (hd (tl V4883)))))) (and (= int (hd (hd (tl (hd (hd (tl V4883))))))) (and (cons? (tl (hd (tl (hd (hd (tl V4883))))))) (and (= () (tl (tl (hd (tl (hd (hd (tl V4883)))))))) (and (= () (tl (tl (hd (hd (tl V4883)))))) (and (= () (tl (hd (tl V4883)))) (= () (tl (tl V4883)))))))))))))) (if (content-eq (hd (hd (hd (tl V4883)))) V4882) (hd (tl (hd (tl (hd (hd (tl V4883))))))) (cons bad ()))) (true (cons bad ())))) + +(defun poly->coeffs (V4884 V4885) (let W4886 (poly-max-deg V4884 V4885) (if (= W4886 (cons bad ())) (cons none ()) (cons some (cons (coeffs-fill V4884 V4885 W4886) ()))))) + +(defun poly-max-deg (V4887 V4888) (cond ((= () V4888) 0) ((cons? V4888) (let W4889 (term-exp-in V4887 (hd V4888)) (if (= W4889 (cons bad ())) (cons bad ()) (let W4890 (poly-max-deg V4887 (tl V4888)) (if (= W4890 (cons bad ())) (cons bad ()) (max W4889 W4890)))))) (true (simple-error "partial function poly-max-deg")))) + +(defun max (V4891 V4892) (if (> V4891 V4892) V4891 V4892)) + +(defun coeffs-fill (V4893 V4894 V4895) (coeffs-loop V4893 V4894 0 V4895)) + +(defun coeffs-loop (V4896 V4897 V4898 V4899) (if (> V4898 V4899) () (cons (coeff-at-deg V4896 V4897 V4898) (coeffs-loop V4896 V4897 (+ V4898 1) V4899)))) + +(defun coeff-at-deg (V4902 V4903 V4904) (cond ((= () V4903) (cons int (cons 0 ()))) ((cons? V4903) (let W4905 (term-exp-in V4902 (hd V4903)) (if (= W4905 V4904) (term-coeff (hd V4903)) (coeff-at-deg V4902 (tl V4903) V4904)))) (true (simple-error "partial function coeff-at-deg")))) + +(defun coeffs->poly (V4906 V4907) (canon-sort-poly (coeffs->terms V4906 V4907 0))) + +(defun coeffs->terms (V4910 V4911 V4912) (cond ((= () V4911) ()) ((cons? V4911) (if (num-eq? (hd V4911) (cons int (cons 0 ()))) (coeffs->terms V4910 (tl V4911) (+ V4912 1)) (cons (coeff->term V4910 (hd V4911) V4912) (coeffs->terms V4910 (tl V4911) (+ V4912 1))))) (true (simple-error "partial function coeffs->terms")))) + +(defun coeff->term (V4913 V4914 V4915) (cond ((= 0 V4915) (cons V4914 (cons () ()))) (true (cons V4914 (cons (cons (cons V4913 (cons (cons int (cons V4915 ())) ())) ()) ()))))) + +(defun trim-coeffs (V4916) (reverse (drop-leading-zeros (reverse V4916)))) + +(defun drop-leading-zeros (V4917) (cond ((= () V4917) ()) ((cons? V4917) (if (num-eq? (hd V4917) (cons int (cons 0 ()))) (drop-leading-zeros (tl V4917)) V4917)) (true (simple-error "partial function drop-leading-zeros")))) + +(defun coeffs-deg (V4918) (let W4919 (trim-coeffs V4918) (- (length W4919) 1))) + +(defun coeffs-lead (V4920) (let W4921 (trim-coeffs V4920) (if (empty? W4921) (cons int (cons 0 ())) (last-of W4921)))) + +(defun last-of (V4924) (cond ((and (cons? V4924) (= () (tl V4924))) (hd V4924)) ((cons? V4924) (last-of (tl V4924))) (true (simple-error "partial function last-of")))) + +(defun expr->coeffs (V4925 V4926) (poly->coeffs V4925 (expr->poly V4926))) + +(defun vec-add (V4927 V4928) (cond ((= () V4927) V4928) ((= () V4928) V4927) ((and (cons? V4927) (cons? V4928)) (cons (num-add (hd V4927) (hd V4928)) (vec-add (tl V4927) (tl V4928)))) (true (simple-error "partial function vec-add")))) + +(defun vec-sub (V4929 V4930) (vec-add V4929 (vec-neg V4930))) + +(defun vec-neg (V4931) (cond ((= () V4931) ()) ((cons? V4931) (cons (num-mul (cons int (cons -1 ())) (hd V4931)) (vec-neg (tl V4931)))) (true (simple-error "partial function vec-neg")))) + +(defun vec-scale (V4932 V4933) (cond ((= () V4933) ()) ((cons? V4933) (cons (num-mul V4932 (hd V4933)) (vec-scale V4932 (tl V4933)))) (true (simple-error "partial function vec-scale")))) + +(defun vec-shift (V4934 V4935) (cond ((= 0 V4934) V4935) (true (cons (cons int (cons 0 ())) (vec-shift (- V4934 1) V4935))))) + +(defun vec-mul (V4940 V4941) (cond ((= () V4940) ()) ((= () V4941) ()) (true (vec-mul-loop V4940 V4941 0)))) + +(defun vec-mul-loop (V4946 V4947 V4948) (cond ((= () V4946) ()) ((cons? V4946) (vec-add (vec-shift V4948 (vec-scale (hd V4946) V4947)) (vec-mul-loop (tl V4946) V4947 (+ V4948 1)))) (true (simple-error "partial function vec-mul-loop")))) + +(defun uni-divmod (V4949 V4950) (let W4951 (trim-coeffs V4950) (if (empty? W4951) (simple-error "uni-divmod: zero divisor") (divmod-loop (trim-coeffs V4949) W4951 ())))) + +(defun divmod-loop (V4952 V4953 V4954) (let W4955 (trim-coeffs V4952) (let W4956 (coeffs-deg W4955) (let W4957 (coeffs-deg V4953) (if (< W4956 W4957) (cons (qacc->vec V4954) (cons W4955 ())) (let W4958 (coeffs-lead W4955) (let W4959 (coeffs-lead V4953) (let W4960 (num-div W4958 W4959) (let W4961 (- W4956 W4957) (let W4962 (vec-shift W4961 (vec-scale W4960 V4953)) (let W4963 (vec-sub W4955 W4962) (divmod-loop W4963 V4953 (cons (cons W4961 (cons W4960 ())) V4954))))))))))))) + +(defun qacc->vec (V4964) (cond ((= () V4964) ()) (true (qacc-fill V4964 (qacc-maxdeg V4964 0) 0)))) + +(defun qacc-maxdeg (V4967 V4968) (cond ((= () V4967) V4968) ((and (cons? V4967) (and (cons? (hd V4967)) (and (cons? (tl (hd V4967))) (= () (tl (tl (hd V4967))))))) (qacc-maxdeg (tl V4967) (max (hd (hd V4967)) V4968))) (true (simple-error "partial function qacc-maxdeg")))) + +(defun qacc-fill (V4969 V4970 V4971) (if (> V4971 V4970) () (cons (qacc-at V4969 V4971) (qacc-fill V4969 V4970 (+ V4971 1))))) + +(defun qacc-at (V4974 V4975) (cond ((= () V4974) (cons int (cons 0 ()))) ((and (cons? V4974) (and (cons? (hd V4974)) (and (cons? (tl (hd V4974))) (= () (tl (tl (hd V4974))))))) (if (= (hd (hd V4974)) V4975) (hd (tl (hd V4974))) (qacc-at (tl V4974) V4975))) (true (simple-error "partial function qacc-at")))) + +(defun uni-rem (V4976 V4977) (hd (tl (uni-divmod V4976 V4977)))) + +(defun zero-vec? (V4978) (empty? (trim-coeffs V4978))) + +(defun uni-gcd (V4979 V4980) (gcd-loop (trim-coeffs V4979) (trim-coeffs V4980))) + +(defun gcd-loop (V4981 V4982) (cond ((= () V4982) (make-monic V4981)) (true (gcd-loop V4982 (uni-rem V4981 V4982))))) + +(defun make-monic (V4983) (let W4984 (trim-coeffs V4983) (if (empty? W4984) () (vec-scale (num-div (cons int (cons 1 ())) (coeffs-lead W4984)) W4984)))) + +(defun vec-deriv (V4985) (deriv-loop (trim-coeffs V4985) 1)) + +(defun deriv-loop (V4994 V4995) (cond ((= () V4994) ()) ((and (cons? V4994) (= () (tl V4994))) ()) ((and (cons? V4994) (cons? (tl V4994))) (deriv-build (tl V4994) V4995)) (true (simple-error "partial function deriv-loop")))) + +(defun deriv-build (V4998 V4999) (cond ((= () V4998) ()) ((cons? V4998) (cons (num-mul (cons int (cons V4999 ())) (hd V4998)) (deriv-build (tl V4998) (+ V4999 1)))) (true (simple-error "partial function deriv-build")))) + +(defun coeffs->expr (V5000 V5001) (poly->expr (coeffs->poly V5000 (trim-coeffs V5001)))) + +(defun pa-divide-head? (V5004) (cond ((and (cons? V5004) (and (= sym (hd V5004)) (and (cons? (tl V5004)) (= () (tl (tl V5004)))))) (= (str (hd (tl V5004))) "Divide")) (true false))) + +(defun pa-times-head? (V5007) (cond ((and (cons? V5007) (and (= sym (hd V5007)) (and (cons? (tl V5007)) (= () (tl (tl V5007)))))) (= (str (hd (tl V5007))) "Times")) (true false))) + +(defun pa-plus-head? (V5010) (cond ((and (cons? V5010) (and (= sym (hd V5010)) (and (cons? (tl V5010)) (= () (tl (tl V5010)))))) (= (str (hd (tl V5010))) "Plus")) (true false))) + +(defun pa-power-head? (V5013) (cond ((and (cons? V5013) (and (= sym (hd V5013)) (and (cons? (tl V5013)) (= () (tl (tl V5013)))))) (= (str (hd (tl V5013))) "Power")) (true false))) + +(defun pa-divide () (cons sym (cons Divide ()))) + +(defun pa-times () (cons sym (cons Times ()))) + +(defun pa-plus () (cons sym (cons Plus ()))) + +(defun pa-power () (cons sym (cons Power ()))) + +(defun poly-gcd-builtin (V5014 V5015) (trap-error (poly-gcd-attempt V5014 V5015) (lambda Z5016 (cons none ())))) + +(defun poly-gcd-attempt (V5017 V5018) (let W5019 (gcd-shared-var V5017 V5018) (if (= W5019 (cons none ())) (cons none ()) (gcd-with-var (hd (tl W5019)) V5017 V5018)))) + +(defun gcd-shared-var (V5020 V5021) (let W5022 (free-sym-names V5020) (let W5023 (free-sym-names V5021) (let W5024 (dedup-syms (append W5022 W5023)) (if (> (length W5024) 1) (cons none ()) (if (empty? W5024) (cons none ()) (cons some (cons (cons sym (cons (hd W5024) ())) ())))))))) + +(defun gcd-with-var (V5025 V5026 V5027) (let W5028 (expr->coeffs V5025 V5026) (let W5029 (expr->coeffs V5025 V5027) (if (or (= W5028 (cons none ())) (= W5029 (cons none ()))) (cons none ()) (gcd-from-coeffs V5025 (hd (tl W5028)) (hd (tl W5029))))))) + +(defun gcd-from-coeffs (V5030 V5031 V5032) (let W5033 (uni-gcd V5031 V5032) (if (zero-vec? W5033) (cons none ()) (if (and (gcd-divides? V5031 W5033) (gcd-divides? V5032 W5033)) (cons some (cons (coeffs->expr V5030 W5033) ())) (cons none ()))))) + +(defun gcd-divides? (V5034 V5035) (zero-vec? (uni-rem V5034 V5035))) + +(defun cancel-builtin (V5036) (trap-error (cancel-attempt V5036) (lambda Z5037 (cons none ())))) + +(defun cancel-attempt (V5040) (cond ((and (cons? V5040) (and (cons? (tl V5040)) (and (cons? (tl (tl V5040))) (= () (tl (tl (tl V5040))))))) (if (pa-divide-head? (hd V5040)) (cancel-ratio (hd (tl V5040)) (hd (tl (tl V5040)))) (cons none ()))) (true (cons none ())))) + +(defun cancel-ratio (V5041 V5042) (let W5043 (gcd-shared-var V5041 V5042) (if (= W5043 (cons none ())) (cons none ()) (cancel-with-var (hd (tl W5043)) V5041 V5042)))) + +(defun cancel-with-var (V5044 V5045 V5046) (let W5047 (expr->coeffs V5044 V5045) (let W5048 (expr->coeffs V5044 V5046) (if (or (= W5047 (cons none ())) (= W5048 (cons none ()))) (cons none ()) (cancel-from-coeffs V5044 (hd (tl W5047)) (hd (tl W5048))))))) + +(defun cancel-from-coeffs (V5049 V5050 V5051) (let W5052 (uni-gcd V5050 V5051) (if (zero-vec? W5052) (cons none ()) (let W5053 (uni-divmod V5050 W5052) (let W5054 (uni-divmod V5051 W5052) (let W5055 (hd W5053) (let W5056 (hd (tl W5053)) (let W5057 (hd W5054) (let W5058 (hd (tl W5054)) (if (and (zero-vec? W5056) (zero-vec? W5058)) (cancel-build V5049 W5055 W5057) (cons none ()))))))))))) + +(defun cancel-build (V5059 V5060 V5061) (let W5062 (trim-coeffs V5061) (if (and (= (coeffs-deg W5062) 0) (num-eq? (coeffs-lead W5062) (cons int (cons 1 ())))) (cons some (cons (coeffs->expr V5059 V5060) ())) (cons some (cons (cons (pa-divide) (cons (coeffs->expr V5059 V5060) (cons (coeffs->expr V5059 V5061) ()))) ()))))) + +(defun together-builtin (V5063) (trap-error (together-attempt V5063) (lambda Z5064 (cons none ())))) + +(defun together-attempt (V5067) (cond ((cons? V5067) (if (pa-plus-head? (hd V5067)) (together-plus (tl V5067)) (cons none ()))) (true (cons none ())))) + +(defun together-plus (V5068) (let W5069 (together-var V5068) (if (= W5069 (cons none ())) (cons none ()) (together-with-var (hd (tl W5069)) V5068)))) + +(defun together-var (V5070) (let W5071 (dedup-syms (free-syms-of-list V5070)) (if (> (length W5071) 1) (cons none ()) (if (empty? W5071) (cons none ()) (cons some (cons (cons sym (cons (hd W5071) ())) ())))))) + +(defun free-syms-of-list (V5072) (cond ((= () V5072) ()) ((cons? V5072) (append (free-sym-names (hd V5072)) (free-syms-of-list (tl V5072)))) (true (simple-error "partial function free-syms-of-list")))) + +(defun together-with-var (V5073 V5074) (let W5075 (addends->fracs V5073 V5074 ()) (if (= W5075 (cons none ())) (cons none ()) (together-combine V5073 (hd (tl W5075)))))) + +(defun addends->fracs (V5076 V5077 V5078) (cond ((= () V5077) (cons some (cons (reverse V5078) ()))) ((cons? V5077) (let W5079 (addend->frac V5076 (hd V5077)) (if (= W5079 (cons none ())) (cons none ()) (addends->fracs V5076 (tl V5077) (cons (hd (tl W5079)) V5078))))) (true (simple-error "partial function addends->fracs")))) + +(defun addend->frac (V5080 V5081) (cond ((and (cons? V5081) (and (cons? (tl V5081)) (and (cons? (tl (tl V5081))) (= () (tl (tl (tl V5081))))))) (addend-divide V5080 (hd V5081) (hd (tl V5081)) (hd (tl (tl V5081))))) (true (addend-poly V5080 V5081)))) + +(defun addend-divide (V5082 V5083 V5084 V5085) (if (pa-divide-head? V5083) (let W5086 (expr->coeffs V5082 V5084) (let W5087 (expr->coeffs V5082 V5085) (if (or (= W5086 (cons none ())) (= W5087 (cons none ()))) (cons none ()) (cons some (cons (cons (hd (tl W5086)) (cons (hd (tl W5087)) ())) ()))))) (addend-poly V5082 (cons V5083 (cons V5084 (cons V5085 ())))))) + +(defun addend-poly (V5088 V5089) (let W5090 (expr->coeffs V5088 V5089) (if (= W5090 (cons none ())) (cons none ()) (cons some (cons (cons (hd (tl W5090)) (cons (cons (cons int (cons 1 ())) ()) ())) ()))))) + +(defun together-combine (V5091 V5092) (let W5093 (sum-fracs V5092) (let W5094 (hd W5093) (let W5095 (hd (tl W5093)) (together-emit V5091 W5094 W5095))))) + +(defun sum-fracs (V5096) (cond ((and (cons? V5096) (= () (tl V5096))) (hd V5096)) ((cons? V5096) (add-frac (hd V5096) (sum-fracs (tl V5096)))) (true (simple-error "partial function sum-fracs")))) + +(defun add-frac (V5097 V5098) (cond ((and (cons? V5097) (and (cons? (tl V5097)) (and (= () (tl (tl V5097))) (and (cons? V5098) (and (cons? (tl V5098)) (= () (tl (tl V5098)))))))) (cons (vec-add (vec-mul (hd V5097) (hd (tl V5098))) (vec-mul (hd V5098) (hd (tl V5097)))) (cons (vec-mul (hd (tl V5097)) (hd (tl V5098))) ()))) (true (simple-error "partial function add-frac")))) + +(defun together-emit (V5099 V5100 V5101) (let W5102 (uni-gcd V5100 V5101) (if (zero-vec? W5102) (cons some (cons (coeffs->expr V5099 V5100) ())) (let W5103 (hd (uni-divmod V5100 W5102)) (let W5104 (hd (uni-divmod V5101 W5102)) (together-emit-norm V5099 W5103 W5104)))))) + +(defun together-emit-norm (V5105 V5106 V5107) (let W5108 (trim-coeffs V5107) (let W5109 (coeffs-lead W5108) (let W5110 (if (num-neg? W5109) (cons int (cons -1 ())) (cons int (cons 1 ()))) (let W5111 (vec-scale W5110 V5106) (let W5112 (vec-scale W5110 W5108) (if (and (= (coeffs-deg W5112) 0) (num-eq? (coeffs-lead W5112) (cons int (cons 1 ())))) (cons some (cons (coeffs->expr V5105 W5111) ())) (cons some (cons (cons (pa-divide) (cons (coeffs->expr V5105 W5111) (cons (coeffs->expr V5105 W5112) ()))) ()))))))))) + +(defun num-neg? (V5113) (< (rat-num (as-rat V5113)) 0)) + +(defun factor-builtin (V5114) (trap-error (factor-attempt V5114) (lambda Z5115 (cons none ())))) + +(defun factor-attempt (V5116) (let W5117 (single-var V5116) (if (= W5117 (cons none ())) (cons none ()) (factor-with-var (hd (tl W5117)) V5116)))) + +(defun factor-with-var (V5118 V5119) (let W5120 (expr->coeffs V5118 V5119) (if (= W5120 (cons none ())) (cons none ()) (factor-from-coeffs V5118 V5119 (trim-coeffs (hd (tl W5120))))))) + +(defun factor-from-coeffs (V5121 V5122 V5123) (if (< (coeffs-deg V5123) 1) (cons none ()) (let W5124 (factor-vec V5121 V5123) (factor-verify V5121 V5122 W5124)))) + +(defun factor-verify (V5125 V5126 V5127) (let W5128 (factors-product-expr V5127) (if (content-eq (poly-expand W5128) (poly-expand V5126)) (cons some (cons (factors->result V5127) ())) (cons none ())))) + +(defun factors-product-expr (V5129) (cond ((= () V5129) (cons int (cons 1 ()))) ((and (cons? V5129) (= () (tl V5129))) (hd V5129)) (true (cons (pa-times) V5129)))) + +(defun factors->result (V5130) (cond ((= () V5130) (cons int (cons 1 ()))) ((and (cons? V5130) (= () (tl V5130))) (hd V5130)) (true (cons (pa-times) V5130)))) + +(defun factor-vec (V5131 V5132) (let W5133 (vec-content V5132) (let W5134 (vec-scale (num-div (cons int (cons 1 ())) W5133) V5132) (let W5135 (if (num-eq? W5133 (cons int (cons 1 ()))) () (cons W5133 ())) (append W5135 (factor-sqfree-roots V5131 W5134)))))) + +(defun vec-content (V5136) (coeffs-lead V5136)) + +(defun factor-sqfree-roots (V5137 V5138) (let W5139 (rational-roots V5138) (extract-linear-factors V5137 (make-monic V5138) W5139))) + +(defun extract-linear-factors (V5140 V5141 V5142) (cond ((= () V5142) (leftover-factor V5140 V5141)) ((cons? V5142) (let W5143 (linear-vec (hd V5142)) (let W5144 (uni-divmod V5141 W5143) (let W5145 (hd W5144) (let W5146 (hd (tl W5144)) (if (zero-vec? W5146) (cons (linear-expr V5140 (hd V5142)) (extract-linear-factors V5140 W5145 V5142)) (extract-linear-factors V5140 V5141 (tl V5142)))))))) (true (simple-error "partial function extract-linear-factors")))) + +(defun leftover-factor (V5147 V5148) (let W5149 (trim-coeffs V5148) (if (< (coeffs-deg W5149) 1) (if (num-eq? (coeffs-lead W5149) (cons int (cons 1 ()))) () (cons (coeffs->expr V5147 W5149) ())) (cons (coeffs->expr V5147 W5149) ())))) + +(defun linear-vec (V5150) (cons (num-mul (cons int (cons -1 ())) V5150) (cons (cons int (cons 1 ())) ()))) + +(defun linear-expr (V5151 V5152) (coeffs->expr V5151 (linear-vec V5152))) + +(defun rational-roots (V5153) (let W5154 (clear-denoms V5153) (if (= W5154 (cons none ())) () (let W5155 (hd (tl W5154)) (let W5156 (rat-num (as-rat (hd W5155))) (let W5157 (rat-num (as-rat (last-of W5155))) (if (or (= W5156 0) (= W5157 0)) (roots-with-zero V5153) (candidate-roots V5153 W5156 W5157)))))))) + +(defun roots-with-zero (V5158) (cons (make-rat 0 1) (rational-roots (hd (uni-divmod V5158 (cons (cons int (cons 0 ())) (cons (cons int (cons 1 ())) ()))))))) + +(defun candidate-roots (V5159 V5160 V5161) (filter-roots V5159 (dedup-rats (gen-candidates (divisors (abs-num V5160)) (divisors (abs-num V5161)))))) + +(defun gen-candidates (V5162 V5163) (gen-cand-p V5162 V5163)) + +(defun gen-cand-p (V5166 V5167) (cond ((= () V5166) ()) ((cons? V5166) (append (gen-cand-q (hd V5166) V5167) (gen-cand-p (tl V5166) V5167))) (true (simple-error "partial function gen-cand-p")))) + +(defun gen-cand-q (V5170 V5171) (cond ((= () V5171) ()) ((cons? V5171) (cons (make-rat V5170 (hd V5171)) (cons (make-rat (- 0 V5170) (hd V5171)) (gen-cand-q V5170 (tl V5171))))) (true (simple-error "partial function gen-cand-q")))) + +(defun divisors (V5172) (if (<= V5172 0) (cons 1 ()) (divisors-loop V5172 1 ()))) + +(defun divisors-loop (V5173 V5174 V5175) (if (> V5174 V5173) (reverse V5175) (if (= (- V5173 (* (intdiv V5173 V5174) V5174)) 0) (divisors-loop V5173 (+ V5174 1) (cons V5174 V5175)) (divisors-loop V5173 (+ V5174 1) V5175)))) + +(defun dedup-rats (V5176) (cond ((= () V5176) ()) ((cons? V5176) (if (rat-member? (hd V5176) (tl V5176)) (dedup-rats (tl V5176)) (cons (hd V5176) (dedup-rats (tl V5176))))) (true (simple-error "partial function dedup-rats")))) + +(defun rat-member? (V5179 V5180) (cond ((= () V5180) false) ((cons? V5180) (if (num-eq? V5179 (hd V5180)) true (rat-member? V5179 (tl V5180)))) (true (simple-error "partial function rat-member?")))) + +(defun filter-roots (V5183 V5184) (cond ((= () V5184) ()) ((cons? V5184) (if (num-eq? (vec-eval V5183 (hd V5184)) (cons int (cons 0 ()))) (cons (hd V5184) (filter-roots V5183 (tl V5184))) (filter-roots V5183 (tl V5184)))) (true (simple-error "partial function filter-roots")))) + +(defun vec-eval (V5185 V5186) (vec-eval-loop (trim-coeffs V5185) V5186 (cons int (cons 1 ())) (cons int (cons 0 ())))) + +(defun vec-eval-loop (V5191 V5192 V5193 V5194) (cond ((= () V5191) V5194) ((cons? V5191) (vec-eval-loop (tl V5191) V5192 (num-mul V5193 V5192) (num-add V5194 (num-mul (hd V5191) V5193)))) (true (simple-error "partial function vec-eval-loop")))) + +(defun clear-denoms (V5195) (trap-error (cons some (cons (clear-denoms! (trim-coeffs V5195)) ())) (lambda Z5196 (cons none ())))) + +(defun clear-denoms! (V5197) (let W5198 (vec-lcm-denom V5197 1) (vec-clear V5197 W5198))) + +(defun vec-lcm-denom (V5199 V5200) (cond ((= () V5199) V5200) ((cons? V5199) (vec-lcm-denom (tl V5199) (lcm-int V5200 (rat-den (as-rat (hd V5199)))))) (true (simple-error "partial function vec-lcm-denom")))) + +(defun lcm-int (V5201 V5202) (intdiv (* V5201 V5202) (gcd V5201 V5202))) + +(defun vec-clear (V5205 V5206) (cond ((= () V5205) ()) ((cons? V5205) (cons (num-mul (hd V5205) (cons int (cons V5206 ()))) (vec-clear (tl V5205) V5206))) (true (simple-error "partial function vec-clear")))) + +(defun apart-builtin (V5207) (trap-error (apart-attempt V5207) (lambda Z5208 (cons none ())))) + +(defun apart-attempt (V5211) (cond ((and (cons? V5211) (and (cons? (tl V5211)) (and (cons? (tl (tl V5211))) (= () (tl (tl (tl V5211))))))) (if (pa-divide-head? (hd V5211)) (apart-on-divide (hd (tl V5211)) (hd (tl (tl V5211)))) (cons none ()))) (true (cons none ())))) + +(defun apart-on-divide (V5212 V5213) (apart-pick-var (gcd-shared-var V5212 V5213) V5212 V5213)) + +(defun apart-pick-var (V5214 V5215 V5216) (cond ((and (cons? V5214) (and (= some (hd V5214)) (and (cons? (tl V5214)) (= () (tl (tl V5214)))))) (apart-coeffs (hd (tl V5214)) (expr->coeffs (hd (tl V5214)) V5215) (expr->coeffs (hd (tl V5214)) V5216))) ((and (cons? V5214) (and (= none (hd V5214)) (= () (tl V5214)))) V5214) (true (simple-error "partial function apart-pick-var")))) + +(defun apart-coeffs (V5221 V5222 V5223) (cond ((and (cons? V5222) (and (= some (hd V5222)) (and (cons? (tl V5222)) (and (= () (tl (tl V5222))) (and (cons? V5223) (and (= some (hd V5223)) (and (cons? (tl V5223)) (= () (tl (tl V5223)))))))))) (apart-monic V5221 (trim-coeffs (hd (tl V5222))) (trim-coeffs (hd (tl V5223))))) (true (cons none ())))) + +(defun apart-monic (V5224 V5225 V5226) (let W5227 (coeffs-lead V5226) (let W5228 (make-monic V5226) (let W5229 (vec-scale (num-div (cons int (cons 1 ())) W5227) V5225) (if (< (coeffs-deg W5229) (coeffs-deg W5228)) (apart-roots V5224 W5229 W5228 (rational-roots W5228)) (cons none ())))))) + +(defun apart-roots (V5230 V5231 V5232 V5233) (if (= (length V5233) (coeffs-deg V5232)) (if (vec-eq? (apart-prod V5233) V5232) (apart-gate V5230 (apart-terms V5231 V5233 V5233) V5231 V5232) (cons none ())) (cons none ()))) + +(defun apart-prod (V5234) (cond ((= () V5234) (cons (cons int (cons 1 ())) ())) ((cons? V5234) (vec-mul (linear-vec (hd V5234)) (apart-prod (tl V5234)))) (true (simple-error "partial function apart-prod")))) + +(defun apart-terms (V5239 V5240 V5241) (cond ((= () V5240) ()) ((cons? V5240) (cons (cons (apart-residue V5239 (hd V5240) V5241) (cons (linear-vec (hd V5240)) ())) (apart-terms V5239 (tl V5240) V5241))) (true (simple-error "partial function apart-terms")))) + +(defun apart-residue (V5242 V5243 V5244) (num-div (vec-eval V5242 V5243) (apart-proddiff V5243 V5244))) + +(defun apart-proddiff (V5247 V5248) (cond ((= () V5248) (cons int (cons 1 ()))) ((cons? V5248) (if (num-eq? V5247 (hd V5248)) (apart-proddiff V5247 (tl V5248)) (num-mul (num-sub V5247 (hd V5248)) (apart-proddiff V5247 (tl V5248))))) (true (simple-error "partial function apart-proddiff")))) + +(defun apart-gate (V5249 V5250 V5251 V5252) (apart-gate-2 V5249 V5250 V5251 V5252 (sum-fracs (apart-fracs V5250)))) + +(defun apart-fracs (V5253) (cond ((= () V5253) ()) ((and (cons? V5253) (and (cons? (hd V5253)) (and (cons? (tl (hd V5253))) (= () (tl (tl (hd V5253))))))) (cons (cons (cons (hd (hd V5253)) ()) (tl (hd V5253))) (apart-fracs (tl V5253)))) (true (simple-error "partial function apart-fracs")))) + +(defun apart-gate-2 (V5256 V5257 V5258 V5259 V5260) (cond ((and (cons? V5260) (and (cons? (tl V5260)) (= () (tl (tl V5260))))) (if (vec-eq? (hd V5260) V5258) (if (vec-eq? (hd (tl V5260)) V5259) (cons some (cons (apart-emit V5256 V5257) ())) (cons none ())) (cons none ()))) (true (cons none ())))) + +(defun apart-emit (V5261 V5262) (cond ((and (cons? V5262) (= () (tl V5262))) (apart-term V5261 (hd V5262))) (true (cons (pa-plus) (apart-emit-list V5261 V5262))))) + +(defun apart-emit-list (V5265 V5266) (cond ((= () V5266) ()) ((cons? V5266) (cons (apart-term V5265 (hd V5266)) (apart-emit-list V5265 (tl V5266)))) (true (simple-error "partial function apart-emit-list")))) + +(defun apart-term (V5267 V5268) (cond ((and (cons? V5268) (and (cons? (tl V5268)) (= () (tl (tl V5268))))) (if (num-eq? (hd V5268) (cons int (cons 1 ()))) (cons (pa-power) (cons (coeffs->expr V5267 (hd (tl V5268))) (cons (cons int (cons -1 ())) ()))) (cons (pa-times) (cons (hd V5268) (cons (cons (pa-power) (cons (coeffs->expr V5267 (hd (tl V5268))) (cons (cons int (cons -1 ())) ()))) ()))))) (true (simple-error "partial function apart-term")))) + +(defun vec-eq? (V5269 V5270) (vec-eq-loop (trim-coeffs V5269) (trim-coeffs V5270))) + +(defun vec-eq-loop (V5275 V5276) (cond ((and (= () V5275) (= () V5276)) true) ((= () V5275) false) ((= () V5276) false) ((and (cons? V5275) (cons? V5276)) (if (num-eq? (hd V5275) (hd V5276)) (vec-eq-loop (tl V5275) (tl V5276)) false)) (true (simple-error "partial function vec-eq-loop")))) + +(pr "polyalg.shen loaded (univariate Q: PolynomialGCD/Cancel/Together/Factor/Apart). +" (stoutput)) + +(defun sv-equal-head? (V5279) (cond ((and (cons? V5279) (and (= sym (hd V5279)) (and (cons? (tl V5279)) (= () (tl (tl V5279)))))) (= (str (hd (tl V5279))) "Equal")) (true false))) + +(defun sv-plus () (cons sym (cons Plus ()))) + +(defun sv-times () (cons sym (cons Times ()))) + +(defun sv-power () (cons sym (cons Power ()))) + +(defun sv-list () (cons sym (cons List ()))) + +(defun sv-sqrt () (cons sym (cons Sqrt ()))) + +(defun sv-head (V5284) (cond ((cons? V5284) (hd V5284)) (true (cons none ())))) + +(defun solve-builtin (V5285 V5286) (trap-error (solve-attempt V5285 V5286) (lambda Z5287 (cons none ())))) + +(defun solve-attempt (V5290 V5291) (cond ((and (cons? V5291) (and (= sym (hd V5291)) (and (cons? (tl V5291)) (= () (tl (tl V5291)))))) (solve-with-var V5290 V5291)) (true (cons none ())))) + +(defun solve-with-var (V5292 V5293) (solve-poly (solve-normalize V5292) V5293)) + +(defun solve-normalize (V5294) (cond ((and (cons? V5294) (and (cons? (tl V5294)) (and (cons? (tl (tl V5294))) (= () (tl (tl (tl V5294))))))) (if (sv-equal-head? (hd V5294)) (cons (sv-plus) (cons (hd (tl V5294)) (cons (cons (sv-times) (cons (cons int (cons -1 ())) (tl (tl V5294)))) ()))) V5294)) (true V5294))) + +(defun solve-poly (V5295 V5296) (if (solve-univariate-in? V5295 V5296) (solve-coeffs V5295 V5296 (expr->coeffs V5296 V5295)) (cons none ()))) + +(defun solve-univariate-in? (V5297 V5298) (cond ((and (cons? V5298) (and (= sym (hd V5298)) (and (cons? (tl V5298)) (= () (tl (tl V5298)))))) (solve-names-subset? (free-sym-names V5297) (hd (tl V5298)))) (true (simple-error "partial function solve-univariate-in?")))) + +(defun solve-names-subset? (V5301 V5302) (cond ((= () V5301) true) ((cons? V5301) (if (= (hd V5301) V5302) (solve-names-subset? (tl V5301) V5302) false)) (true (simple-error "partial function solve-names-subset?")))) + +(defun solve-coeffs (V5307 V5308 V5309) (cond ((and (cons? V5309) (and (= none (hd V5309)) (= () (tl V5309)))) V5309) ((and (cons? V5309) (and (= some (hd V5309)) (and (cons? (tl V5309)) (= () (tl (tl V5309)))))) (solve-dispatch V5307 V5308 (trim-coeffs (hd (tl V5309))))) (true (simple-error "partial function solve-coeffs")))) + +(defun solve-dispatch (V5310 V5311 V5312) (let W5313 (coeffs-deg V5312) (if (= W5313 -1) (cons none ()) (if (= W5313 0) (cons some (cons (cons (sv-list) ()) ())) (if (= W5313 1) (solve-finish V5310 V5311 (solve-linear V5312)) (if (= W5313 2) (solve-finish V5310 V5311 (solve-quadratic V5312)) (solve-finish V5310 V5311 (solve-highdeg V5310 V5311 V5312)))))))) + +(defun solve-finish (V5318 V5319 V5320) (cond ((and (cons? V5320) (and (= none (hd V5320)) (= () (tl V5320)))) V5320) ((and (cons? V5320) (and (= some (hd V5320)) (and (cons? (tl V5320)) (= () (tl (tl V5320)))))) (solve-gate V5318 V5319 (sv-dedup-roots (hd (tl V5320))))) (true (simple-error "partial function solve-finish")))) + +(defun solve-linear (V5321) (let W5322 (hd V5321) (let W5323 (hd (tl V5321)) (cons some (cons (cons (num-div (num-mul (cons int (cons -1 ())) W5322) W5323) ()) ()))))) + +(defun solve-quadratic (V5324) (let W5325 (hd V5324) (let W5326 (hd (tl V5324)) (let W5327 (hd (tl (tl V5324))) (let W5328 (num-sub (num-mul W5326 W5326) (num-mul (cons int (cons 4 ())) (num-mul W5327 W5325))) (solve-quad-from-disc W5325 W5326 W5327 W5328)))))) + +(defun solve-quad-from-disc (V5329 V5330 V5331 V5332) (let W5333 (perfect-rat-sqrt V5332) (if (= W5333 (cons none ())) (solve-quad-symbolic V5330 V5331 V5332) (solve-quad-rational V5330 V5331 (hd (tl W5333)))))) + +(defun solve-quad-rational (V5334 V5335 V5336) (let W5337 (num-mul (cons int (cons 2 ())) V5335) (let W5338 (num-mul (cons int (cons -1 ())) V5334) (let W5339 (num-div (num-add W5338 V5336) W5337) (let W5340 (num-div (num-sub W5338 V5336) W5337) (cons some (cons (cons W5339 (cons W5340 ())) ()))))))) + +(defun solve-quad-symbolic (V5341 V5342 V5343) (let W5344 (num-mul (cons int (cons 2 ())) V5342) (let W5345 (num-mul (cons int (cons -1 ())) V5341) (let W5346 (sv-quad-root W5345 V5343 W5344 (cons int (cons 1 ()))) (let W5347 (sv-quad-root W5345 V5343 W5344 (cons int (cons -1 ()))) (cons some (cons (cons W5346 (cons W5347 ())) ()))))))) + +(defun sv-quad-root (V5348 V5349 V5350 V5351) (reduce (cons (sv-times) (cons (cons (sv-plus) (cons V5348 (cons (cons (sv-times) (cons V5351 (cons (cons (sv-sqrt) (cons V5349 ())) ()))) ()))) (cons (cons (sv-power) (cons V5350 (cons (cons int (cons -1 ())) ()))) ()))))) + +(defun perfect-rat-sqrt (V5352) (let W5353 (as-rat V5352) (let W5354 (rat-num W5353) (let W5355 (rat-den W5353) (if (< W5354 0) (cons none ()) (let W5356 (int-sqrt W5354) (let W5357 (int-sqrt W5355) (if (or (= W5356 (cons none ())) (= W5357 (cons none ()))) (cons none ()) (cons some (cons (make-rat (hd (tl W5356)) (hd (tl W5357))) ())))))))))) + +(defun int-sqrt (V5358) (cond ((= 0 V5358) (cons some (cons 0 ()))) (true (int-sqrt-loop V5358 1)))) + +(defun int-sqrt-loop (V5359 V5360) (let W5361 (* V5360 V5360) (if (= W5361 V5359) (cons some (cons V5360 ())) (if (> W5361 V5359) (cons none ()) (int-sqrt-loop V5359 (+ V5360 1)))))) + +(defun solve-highdeg (V5362 V5363 V5364) (let W5365 (factor-builtin V5362) (if (= W5365 (cons none ())) (cons none ()) (solve-factors V5363 (sv-factor-list (hd (tl W5365))))))) + +(defun sv-factor-list (V5366) (cond ((cons? V5366) (if (sv-times-head? (hd V5366)) (tl V5366) (cons V5366 ()))) (true (cons V5366 ())))) + +(defun sv-times-head? (V5369) (cond ((and (cons? V5369) (and (= sym (hd V5369)) (and (cons? (tl V5369)) (= () (tl (tl V5369)))))) (= (str (hd (tl V5369))) "Times")) (true false))) + +(defun solve-factors (V5370 V5371) (cond ((= () V5371) (cons some (cons () ()))) ((cons? V5371) (sv-merge-factor-roots (solve-one-factor V5370 (hd V5371)) V5370 (tl V5371))) (true (simple-error "partial function solve-factors")))) + +(defun sv-merge-factor-roots (V5376 V5377 V5378) (cond ((and (cons? V5376) (and (= none (hd V5376)) (= () (tl V5376)))) V5376) ((and (cons? V5376) (and (= some (hd V5376)) (and (cons? (tl V5376)) (= () (tl (tl V5376)))))) (sv-merge-rest (hd (tl V5376)) (solve-factors V5377 V5378))) (true (simple-error "partial function sv-merge-factor-roots")))) + +(defun sv-merge-rest (V5381 V5382) (cond ((and (cons? V5382) (and (= none (hd V5382)) (= () (tl V5382)))) V5382) ((and (cons? V5382) (and (= some (hd V5382)) (and (cons? (tl V5382)) (= () (tl (tl V5382)))))) (cons some (cons (append V5381 (hd (tl V5382))) ()))) (true (simple-error "partial function sv-merge-rest")))) + +(defun solve-one-factor (V5383 V5384) (if (numeric? V5384) (cons some (cons () ())) (if (free-of? V5384 V5383) (cons some (cons () ())) (solve-factor-coeffs V5383 V5384 (expr->coeffs V5383 V5384))))) + +(defun solve-factor-coeffs (V5385 V5386 V5387) (cond ((and (cons? V5387) (and (= none (hd V5387)) (= () (tl V5387)))) V5387) ((and (cons? V5387) (and (= some (hd V5387)) (and (cons? (tl V5387)) (= () (tl (tl V5387)))))) (solve-factor-by-deg V5385 (trim-coeffs (hd (tl V5387))))) (true (simple-error "partial function solve-factor-coeffs")))) + +(defun solve-factor-by-deg (V5388 V5389) (let W5390 (coeffs-deg V5389) (if (= W5390 1) (solve-linear V5389) (if (= W5390 2) (solve-quadratic V5389) (if (= W5390 0) (cons some (cons () ())) (cons none ())))))) + +(defun sv-dedup-roots (V5391) (cond ((= () V5391) ()) ((cons? V5391) (if (sv-root-member? (hd V5391) (tl V5391)) (sv-dedup-roots (tl V5391)) (cons (hd V5391) (sv-dedup-roots (tl V5391))))) (true (simple-error "partial function sv-dedup-roots")))) + +(defun sv-root-member? (V5394 V5395) (cond ((= () V5395) false) ((cons? V5395) (if (content-eq V5394 (hd V5395)) true (sv-root-member? V5394 (tl V5395)))) (true (simple-error "partial function sv-root-member?")))) + +(defun solve-gate (V5396 V5397 V5398) (if (sv-verify-all V5396 V5397 V5398) (cons some (cons (cons (sv-list) V5398) ())) (cons none ()))) + +(defun sv-verify-all (V5403 V5404 V5405) (cond ((= () V5405) true) ((cons? V5405) (if (sv-verify-one V5403 V5404 (hd V5405)) (sv-verify-all V5403 V5404 (tl V5405)) false)) (true (simple-error "partial function sv-verify-all")))) + +(defun sv-verify-one (V5406 V5407 V5408) (sv-zero? (reduce (sv-subst V5407 V5408 V5406)))) + +(defun sv-zero? (V5409) (if (numeric? V5409) (num-eq? V5409 (cons int (cons 0 ()))) false)) + +(defun sv-subst (V5410 V5411 V5412) (cond ((and (cons? V5412) (and (= sym (hd V5412)) (and (cons? (tl V5412)) (= () (tl (tl V5412)))))) (if (content-eq V5410 V5412) V5411 V5412)) ((and (cons? V5412) (and (= int (hd V5412)) (and (cons? (tl V5412)) (= () (tl (tl V5412)))))) V5412) ((and (cons? V5412) (and (= rat (hd V5412)) (and (cons? (tl V5412)) (and (cons? (tl (tl V5412))) (= () (tl (tl (tl V5412)))))))) V5412) ((cons? V5412) (cons (sv-subst V5410 V5411 (hd V5412)) (sv-subst-list V5410 V5411 (tl V5412)))) (true V5412))) + +(defun sv-subst-list (V5413 V5414 V5415) (cond ((= () V5415) ()) ((cons? V5415) (cons (sv-subst V5413 V5414 (hd V5415)) (sv-subst-list V5413 V5414 (tl V5415)))) (true (simple-error "partial function sv-subst-list")))) + +(pr "solve.shen loaded (Wave D: Solve polynomial equations in one var over Q). +" (stoutput)) + +(defun se-plus () (cons sym (cons Plus ()))) + +(defun se-times () (cons sym (cons Times ()))) + +(defun se-power () (cons sym (cons Power ()))) + +(defun se-d () (cons sym (cons D ()))) + +(defun se-head-name (V5418) (cond ((and (cons? V5418) (and (= sym (hd V5418)) (and (cons? (tl V5418)) (= () (tl (tl V5418)))))) (str (hd (tl V5418)))) (true ""))) + +(defun se-divide-head? (V5421) (cond ((and (cons? V5421) (and (= sym (hd V5421)) (and (cons? (tl V5421)) (= () (tl (tl V5421)))))) (= (str (hd (tl V5421))) "Divide")) (true false))) + +(defun se-subst (V5422 V5423 V5424) (cond ((and (cons? V5424) (and (= sym (hd V5424)) (and (cons? (tl V5424)) (= () (tl (tl V5424)))))) (if (content-eq V5422 V5424) V5423 V5424)) ((and (cons? V5424) (and (= int (hd V5424)) (and (cons? (tl V5424)) (= () (tl (tl V5424)))))) V5424) ((and (cons? V5424) (and (= rat (hd V5424)) (and (cons? (tl V5424)) (and (cons? (tl (tl V5424))) (= () (tl (tl (tl V5424)))))))) V5424) ((cons? V5424) (cons (se-subst V5422 V5423 (hd V5424)) (se-subst-list V5422 V5423 (tl V5424)))) (true V5424))) + +(defun se-subst-list (V5425 V5426 V5427) (cond ((= () V5427) ()) ((cons? V5427) (cons (se-subst V5425 V5426 (hd V5427)) (se-subst-list V5425 V5426 (tl V5427)))) (true (simple-error "partial function se-subst-list")))) + +(defun se-factorial (V5428) (trap-error (cons some (cons (se-fact-loop V5428 1) ())) (lambda Z5429 (cons none ())))) + +(defun se-fact-loop (V5430 V5431) (cond ((= 0 V5430) V5431) (true (se-fact-loop (- V5430 1) (se-guard-mul V5431 V5430))))) + +(defun se-guard-mul (V5432 V5433) (guard-int (* V5432 V5433))) + +(defun se-numeric? (V5434) (numeric? V5434)) + +(defun series-builtin (V5435) (trap-error (series-attempt V5435) (lambda Z5436 (cons none ())))) + +(defun series-attempt (V5439) (cond ((and (cons? V5439) (and (cons? (tl V5439)) (and (cons? (hd (tl V5439))) (and (= sym (hd (hd (tl V5439)))) (and (cons? (tl (hd (tl V5439)))) (and (= () (tl (tl (hd (tl V5439))))) (and (cons? (tl (tl V5439))) (= () (tl (tl (tl V5439))))))))))) (series-go (hd V5439) (hd (tl V5439)) (cons int (cons 0 ())) (hd (tl (tl V5439))))) ((and (cons? V5439) (and (cons? (tl V5439)) (and (cons? (hd (tl V5439))) (and (= sym (hd (hd (tl V5439)))) (and (cons? (tl (hd (tl V5439)))) (and (= () (tl (tl (hd (tl V5439))))) (and (cons? (tl (tl V5439))) (and (cons? (tl (tl (tl V5439)))) (= () (tl (tl (tl (tl V5439))))))))))))) (series-go (hd V5439) (hd (tl V5439)) (hd (tl (tl V5439))) (hd (tl (tl (tl V5439)))))) (true (cons none ())))) + +(defun series-go (V5442 V5443 V5444 V5445) (cond ((and (cons? V5445) (and (= int (hd V5445)) (and (cons? (tl V5445)) (= () (tl (tl V5445)))))) (if (< (hd (tl V5445)) 0) (cons none ()) (series-build V5442 V5443 V5444 (hd (tl V5445))))) (true (cons none ())))) + +(defun series-build (V5446 V5447 V5448 V5449) (let W5450 (series-terms V5446 V5447 V5448 0 V5449 V5446 ()) (if (= W5450 (cons none ())) (cons none ()) (cons some (cons (series-sum (reverse W5450)) ()))))) + +(defun series-terms (V5451 V5452 V5453 V5454 V5455 V5456 V5457) (if (> V5454 V5455) V5457 (series-term-k V5451 V5452 V5453 V5454 V5455 V5456 V5457))) + +(defun series-term-k (V5458 V5459 V5460 V5461 V5462 V5463 V5464) (let W5465 (reduce (se-subst V5459 V5460 V5463)) (if (se-numeric? W5465) (series-term-coeff V5458 V5459 V5460 V5461 V5462 V5463 V5464 W5465) (cons none ())))) + +(defun series-term-coeff (V5466 V5467 V5468 V5469 V5470 V5471 V5472 V5473) (let W5474 (se-factorial V5469) (if (= W5474 (cons none ())) (cons none ()) (series-term-emit V5466 V5467 V5468 V5469 V5470 V5471 V5472 (num-div V5473 (cons int (cons (hd (tl W5474)) ()))))))) + +(defun series-term-emit (V5475 V5476 V5477 V5478 V5479 V5480 V5481 V5482) (let W5483 (if (num-eq? V5482 (cons int (cons 0 ()))) (cons skip ()) (series-term-expr V5482 V5476 V5477 V5478)) (let W5484 (if (= W5483 (cons skip ())) V5481 (cons W5483 V5481)) (let W5485 (reduce (cons (se-d) (cons V5480 (cons V5476 ())))) (series-terms V5475 V5476 V5477 (+ V5478 1) V5479 W5485 W5484))))) + +(defun series-term-expr (V5486 V5487 V5488 V5489) (cond ((= 0 V5489) V5486) (true (reduce (cons (se-times) (cons V5486 (cons (cons (se-power) (cons (series-basis V5487 V5488) (cons (cons int (cons V5489 ())) ()))) ()))))))) + +(defun series-basis (V5490 V5491) (if (num-eq-zero? V5491) V5490 (cons (se-plus) (cons V5490 (cons (cons (se-times) (cons (cons int (cons -1 ())) (cons V5491 ()))) ()))))) + +(defun num-eq-zero? (V5492) (if (numeric? V5492) (num-eq? V5492 (cons int (cons 0 ()))) false)) + +(defun series-sum (V5493) (cond ((= () V5493) (cons int (cons 0 ()))) ((and (cons? V5493) (= () (tl V5493))) (reduce (hd V5493))) (true (reduce (cons (se-plus) V5493))))) + +(defun se-limit-max-depth () 5) + +(defun limit-builtin (V5494) (trap-error (limit-attempt V5494) (lambda Z5495 (cons none ())))) + +(defun limit-attempt (V5498) (cond ((and (cons? V5498) (and (cons? (tl V5498)) (and (cons? (hd (tl V5498))) (and (= sym (hd (hd (tl V5498)))) (and (cons? (tl (hd (tl V5498)))) (and (= () (tl (tl (hd (tl V5498))))) (and (cons? (tl (tl V5498))) (= () (tl (tl (tl V5498))))))))))) (if (se-infinity? (hd (tl (tl V5498)))) (limit-at-infinity (hd V5498) (hd (tl V5498))) (limit-go (hd V5498) (hd (tl V5498)) (hd (tl (tl V5498))) (se-limit-max-depth)))) (true (cons none ())))) + +(defun se-infinity? (V5501) (cond ((and (cons? V5501) (and (= sym (hd V5501)) (and (cons? (tl V5501)) (= () (tl (tl V5501)))))) (= (str (hd (tl V5501))) "Infinity")) (true false))) + +(defun se-recip (V5502) (cons (cons sym (cons Divide ())) (cons (cons int (cons 1 ())) (cons V5502 ())))) + +(defun limit-at-infinity (V5503 V5504) (lim-inf-ratio V5504 (se-as-ratio V5503))) + +(defun lim-inf-ratio (V5507 V5508) (cond ((and (cons? V5508) (and (= some (hd V5508)) (and (cons? (tl V5508)) (and (cons? (hd (tl V5508))) (and (cons? (tl (hd (tl V5508)))) (and (= () (tl (tl (hd (tl V5508))))) (= () (tl (tl V5508))))))))) (lim-inf-coeffs (expr->coeffs V5507 (hd (hd (tl V5508)))) (expr->coeffs V5507 (hd (tl (hd (tl V5508))))))) (true (cons none ())))) + +(defun lim-inf-coeffs (V5513 V5514) (cond ((and (cons? V5513) (and (= some (hd V5513)) (and (cons? (tl V5513)) (and (= () (tl (tl V5513))) (and (cons? V5514) (and (= some (hd V5514)) (and (cons? (tl V5514)) (= () (tl (tl V5514)))))))))) (lim-inf-decide (coeffs-deg (hd (tl V5513))) (coeffs-deg (hd (tl V5514))) (hd (tl V5513)) (hd (tl V5514)))) (true (cons none ())))) + +(defun lim-inf-decide (V5515 V5516 V5517 V5518) (if (< V5515 V5516) (cons some (cons (cons int (cons 0 ())) ())) (if (= V5515 V5516) (cons some (cons (reduce (cons (se-times) (cons (coeffs-lead V5517) (cons (cons (se-power) (cons (coeffs-lead V5518) (cons (cons int (cons -1 ())) ()))) ())))) ())) (cons none ())))) + +(defun limit-go (V5519 V5520 V5521 V5522) (let W5523 (se-try-subst V5519 V5520 V5521) (if (= W5523 (cons none ())) (limit-lhopital V5519 V5520 V5521 V5522) W5523))) + +(defun se-try-subst (V5524 V5525 V5526) (trap-error (se-subst-numeric V5524 V5525 V5526) (lambda Z5527 (cons none ())))) + +(defun se-subst-numeric (V5528 V5529 V5530) (let W5531 (reduce (se-subst V5529 V5530 V5528)) (if (se-numeric? W5531) (cons some (cons W5531 ())) (cons none ())))) + +(defun limit-lhopital (V5532 V5533 V5534 V5535) (cond ((= 0 V5535) (cons none ())) (true (limit-on-ratio (se-as-ratio V5532) V5533 V5534 V5535)))) + +(defun se-as-ratio (V5538) (cond ((and (cons? V5538) (and (cons? (tl V5538)) (and (cons? (tl (tl V5538))) (= () (tl (tl (tl V5538))))))) (if (se-divide-head? (hd V5538)) (cons some (cons (tl V5538) ())) (cons none ()))) (true (cons none ())))) + +(defun limit-on-ratio (V5545 V5546 V5547 V5548) (cond ((and (cons? V5545) (and (= none (hd V5545)) (= () (tl V5545)))) V5545) ((and (cons? V5545) (and (= some (hd V5545)) (and (cons? (tl V5545)) (and (cons? (hd (tl V5545))) (and (cons? (tl (hd (tl V5545)))) (and (= () (tl (tl (hd (tl V5545))))) (= () (tl (tl V5545))))))))) (limit-check-00 (hd (hd (tl V5545))) (hd (tl (hd (tl V5545)))) V5546 V5547 V5548)) (true (simple-error "partial function limit-on-ratio")))) + +(defun limit-check-00 (V5549 V5550 V5551 V5552 V5553) (let W5554 (reduce (se-subst V5551 V5552 V5549)) (let W5555 (reduce (se-subst V5551 V5552 V5550)) (if (se-both-zero? W5554 W5555) (limit-go (se-make-ratio (reduce (cons (se-d) (cons V5549 (cons V5551 ())))) (reduce (cons (se-d) (cons V5550 (cons V5551 ()))))) V5551 V5552 (- V5553 1)) (cons none ()))))) + +(defun se-both-zero? (V5556 V5557) (if (num-eq-zero? V5556) (if (num-eq-zero? V5557) true false) false)) + +(defun se-make-ratio (V5558 V5559) (cons (cons sym (cons Divide ())) (cons V5558 (cons V5559 ())))) + +(pr "series.shen loaded (Wave E: Series + Limit; sound, inert when unjustified). +" (stoutput)) + +(defun boot-declare-structural (V5560 V5561) (if (sig-present? V5560) true (declare-structural V5560 V5561))) + +(boot-declare-structural (protect Plus) (cons (protect flat) (cons (protect orderless) ()))) + +(boot-declare-structural (protect Times) (cons (protect flat) (cons (protect orderless) ()))) + +(boot-declare-structural (protect Power) ()) + +(register-rule (rule (cons (cons sym (cons (protect Plus) ())) (cons (named (protect x) (blank)) (cons (cons int (cons 0 ())) ()))) (cons sym (cons (protect x) ())))) + +(register-rule (rule (cons (cons sym (cons (protect Times) ())) (cons (named (protect x) (blank)) (cons (cons int (cons 1 ())) ()))) (cons sym (cons (protect x) ())))) + +(register-rule (rule (cons (cons sym (cons (protect Times) ())) (cons (named (protect x) (blank)) (cons (cons int (cons 0 ())) ()))) (cons int (cons 0 ())))) + +(register-rule (rule (cons (cons sym (cons (protect Minus) ())) (cons (named (protect x) (blank)) (cons (cons int (cons 0 ())) ()))) (cons sym (cons (protect x) ())))) + +(boot-declare-structural (protect If) ()) + +(register-rule (rule (cons (cons sym (cons (protect If) ())) (cons (cons sym (cons (protect True) ())) (cons (named (protect then) (blank)) (cons (named (protect else) (blank)) ())))) (cons sym (cons (protect then) ())))) + +(register-rule (rule (cons (cons sym (cons (protect If) ())) (cons (cons sym (cons (protect False) ())) (cons (named (protect then) (blank)) (cons (named (protect else) (blank)) ())))) (cons sym (cons (protect else) ())))) + +(pr "boot/arith.shen loaded. +" (stoutput)) + +(register-rule (rule (cons (cons sym (cons (protect Times) ())) (cons (cons named (cons (protect s) (cons (cons blank-null-seq ()) ()))) (cons (cons int (cons 0 ())) (cons (cons named (cons (protect t) (cons (cons blank-null-seq ()) ()))) ())))) (cons int (cons 0 ())))) + +(register-rule (rule (cons (cons sym (cons (protect Times) ())) (cons (cons named (cons (protect s) (cons (cons blank-null-seq ()) ()))) (cons (cons int (cons 1 ())) (cons (cons named (cons (protect t) (cons (cons blank-null-seq ()) ()))) ())))) (cons (cons sym (cons (protect Times) ())) (cons (cons sym (cons (protect s) ())) (cons (cons sym (cons (protect t) ())) ()))))) + +(register-rule (rule (cons condition (cons (cons (cons sym (cons (protect Power) ())) (cons (cons int (cons 0 ())) (cons (cons named (cons (protect n) (cons (cons blank ()) ()))) ()))) (cons (cons (cons sym (cons (protect Positive) ())) (cons (cons sym (cons (protect n) ())) ())) ()))) (cons int (cons 0 ())))) + +(register-rule (rule (cons (cons sym (cons (protect Power) ())) (cons (cons named (cons (protect x) (cons (cons blank ()) ()))) (cons (cons int (cons 1 ())) ()))) (cons sym (cons (protect x) ())))) + +(register-rule (rule (cons condition (cons (cons (cons sym (cons (protect Power) ())) (cons (cons named (cons (protect x) (cons (cons blank ()) ()))) (cons (cons int (cons 0 ())) ()))) (cons (cons (cons sym (cons (protect UnsameQ) ())) (cons (cons sym (cons (protect x) ())) (cons (cons int (cons 0 ())) ()))) ()))) (cons int (cons 1 ())))) + +(register-rule (rule (cons (cons sym (cons (protect Plus) ())) (cons (cons named (cons (protect x) (cons (cons blank ()) ()))) ())) (cons sym (cons (protect x) ())))) + +(register-rule (rule (cons (cons sym (cons (protect Times) ())) (cons (cons named (cons (protect x) (cons (cons blank ()) ()))) ())) (cons sym (cons (protect x) ())))) + +(pr "boot/simplify.shen loaded. +" (stoutput)) + +(defun boot-declare-elem (V5562) (if (sig-present? V5562) true (declare-structural V5562 ()))) + +(boot-declare-elem (protect Sin)) + +(boot-declare-elem (protect Cos)) + +(boot-declare-elem (protect Tan)) + +(boot-declare-elem (protect Sec)) + +(boot-declare-elem (protect Exp)) + +(boot-declare-elem (protect Log)) + +(boot-declare-elem (protect Sqrt)) + +(boot-declare-elem (protect ArcSin)) + +(boot-declare-elem (protect ArcCos)) + +(boot-declare-elem (protect ArcTan)) + +(boot-declare-elem (protect D)) + +(boot-declare-elem (protect Integrate)) + +(register-rule (rule (cons (cons sym (cons (protect Sin) ())) (cons (cons int (cons 0 ())) ())) (cons int (cons 0 ())))) + +(register-rule (rule (cons (cons sym (cons (protect Cos) ())) (cons (cons int (cons 0 ())) ())) (cons int (cons 1 ())))) + +(register-rule (rule (cons (cons sym (cons (protect Exp) ())) (cons (cons int (cons 0 ())) ())) (cons int (cons 1 ())))) + +(register-rule (rule (cons (cons sym (cons (protect Log) ())) (cons (cons int (cons 1 ())) ())) (cons int (cons 0 ())))) + +(register-rule (rule (cons (cons sym (cons (protect Sqrt) ())) (cons (cons int (cons 0 ())) ())) (cons int (cons 0 ())))) + +(register-rule (rule (cons (cons sym (cons (protect Sqrt) ())) (cons (cons int (cons 1 ())) ())) (cons int (cons 1 ())))) + +(register-rule (rule (cons (cons sym (cons (protect Sqrt) ())) (cons (cons named (cons (protect u) (cons (cons blank ()) ()))) ())) (cons (cons sym (cons (protect Power) ())) (cons (cons sym (cons (protect u) ())) (cons (cons rat (cons 1 (cons 2 ()))) ()))))) + +(register-rule (rule (cons (cons sym (cons (protect Power) ())) (cons (cons (cons sym (cons (protect Power) ())) (cons (cons named (cons (protect u) (cons (cons blank ()) ()))) (cons (cons rat (cons 1 (cons 2 ()))) ()))) (cons (cons int (cons 2 ())) ()))) (cons sym (cons (protect u) ())))) + +(pr "boot/elemfun.shen loaded (elementary symbols + exact-value table). +" (stoutput)) + +(register-rule (rule (cons condition (cons (cons (cons sym (cons (protect D) ())) (cons (cons named (cons (protect a) (cons (cons blank ()) ()))) (cons (cons named (cons (protect x) (cons (cons blank ()) ()))) ()))) (cons (cons (cons sym (cons (protect SameQ) ())) (cons (cons sym (cons (protect a) ())) (cons (cons sym (cons (protect x) ())) ()))) ()))) (cons int (cons 1 ())))) + +(register-rule (rule (cons condition (cons (cons (cons sym (cons (protect D) ())) (cons (cons named (cons (protect a) (cons (cons blank ()) ()))) (cons (cons named (cons (protect x) (cons (cons blank ()) ()))) ()))) (cons (cons (cons sym (cons (protect FreeQ) ())) (cons (cons sym (cons (protect a) ())) (cons (cons sym (cons (protect x) ())) ()))) ()))) (cons int (cons 0 ())))) + +(register-rule (rule (cons (cons sym (cons (protect D) ())) (cons (cons (cons sym (cons (protect Plus) ())) (cons (cons named (cons (protect a) (cons (cons blank ()) ()))) (cons (cons named (cons (protect r) (cons (cons blank-seq ()) ()))) ()))) (cons (cons named (cons (protect x) (cons (cons blank ()) ()))) ()))) (cons (cons sym (cons (protect Plus) ())) (cons (cons (cons sym (cons (protect D) ())) (cons (cons sym (cons (protect a) ())) (cons (cons sym (cons (protect x) ())) ()))) (cons (cons (cons sym (cons (protect D) ())) (cons (cons (cons sym (cons (protect Plus) ())) (cons (cons sym (cons (protect r) ())) ())) (cons (cons sym (cons (protect x) ())) ()))) ()))))) + +(register-rule (rule (cons condition (cons (cons (cons sym (cons (protect D) ())) (cons (cons (cons sym (cons (protect Power) ())) (cons (cons named (cons (protect u) (cons (cons blank ()) ()))) (cons (cons named (cons (protect n) (cons (cons blank ()) ()))) ()))) (cons (cons named (cons (protect x) (cons (cons blank ()) ()))) ()))) (cons (cons (cons sym (cons (protect FreeQ) ())) (cons (cons sym (cons (protect n) ())) (cons (cons sym (cons (protect x) ())) ()))) ()))) (cons (cons sym (cons (protect Times) ())) (cons (cons sym (cons (protect n) ())) (cons (cons (cons sym (cons (protect Power) ())) (cons (cons sym (cons (protect u) ())) (cons (cons (cons sym (cons (protect Plus) ())) (cons (cons sym (cons (protect n) ())) (cons (cons int (cons -1 ())) ()))) ()))) (cons (cons (cons sym (cons (protect D) ())) (cons (cons sym (cons (protect u) ())) (cons (cons sym (cons (protect x) ())) ()))) ())))))) + +(register-rule (rule (cons (cons sym (cons (protect D) ())) (cons (cons (cons sym (cons (protect Power) ())) (cons (cons named (cons (protect u) (cons (cons blank ()) ()))) (cons (cons named (cons (protect v) (cons (cons blank ()) ()))) ()))) (cons (cons named (cons (protect x) (cons (cons blank ()) ()))) ()))) (cons (cons sym (cons (protect Times) ())) (cons (cons (cons sym (cons (protect Power) ())) (cons (cons sym (cons (protect u) ())) (cons (cons sym (cons (protect v) ())) ()))) (cons (cons (cons sym (cons (protect D) ())) (cons (cons (cons sym (cons (protect Times) ())) (cons (cons sym (cons (protect v) ())) (cons (cons (cons sym (cons (protect Log) ())) (cons (cons sym (cons (protect u) ())) ())) ()))) (cons (cons sym (cons (protect x) ())) ()))) ()))))) + +(register-rule (rule (cons (cons sym (cons (protect D) ())) (cons (cons (cons sym (cons (protect Times) ())) (cons (cons named (cons (protect a) (cons (cons blank ()) ()))) (cons (cons named (cons (protect r) (cons (cons blank-seq ()) ()))) ()))) (cons (cons named (cons (protect x) (cons (cons blank ()) ()))) ()))) (cons (cons sym (cons (protect Plus) ())) (cons (cons (cons sym (cons (protect Times) ())) (cons (cons (cons sym (cons (protect D) ())) (cons (cons sym (cons (protect a) ())) (cons (cons sym (cons (protect x) ())) ()))) (cons (cons (cons sym (cons (protect Times) ())) (cons (cons sym (cons (protect r) ())) ())) ()))) (cons (cons (cons sym (cons (protect Times) ())) (cons (cons sym (cons (protect a) ())) (cons (cons (cons sym (cons (protect D) ())) (cons (cons (cons sym (cons (protect Times) ())) (cons (cons sym (cons (protect r) ())) ())) (cons (cons sym (cons (protect x) ())) ()))) ()))) ()))))) + +(register-rule (rule (cons (cons sym (cons (protect D) ())) (cons (cons (cons sym (cons (protect Divide) ())) (cons (cons named (cons (protect a) (cons (cons blank ()) ()))) (cons (cons named (cons (protect b) (cons (cons blank ()) ()))) ()))) (cons (cons named (cons (protect x) (cons (cons blank ()) ()))) ()))) (cons (cons sym (cons (protect D) ())) (cons (cons (cons sym (cons (protect Times) ())) (cons (cons sym (cons (protect a) ())) (cons (cons (cons sym (cons (protect Power) ())) (cons (cons sym (cons (protect b) ())) (cons (cons int (cons -1 ())) ()))) ()))) (cons (cons sym (cons (protect x) ())) ()))))) + +(register-rule (rule (cons (cons sym (cons (protect D) ())) (cons (cons (cons sym (cons (protect Sin) ())) (cons (cons named (cons (protect u) (cons (cons blank ()) ()))) ())) (cons (cons named (cons (protect x) (cons (cons blank ()) ()))) ()))) (cons (cons sym (cons (protect Times) ())) (cons (cons (cons sym (cons (protect Cos) ())) (cons (cons sym (cons (protect u) ())) ())) (cons (cons (cons sym (cons (protect D) ())) (cons (cons sym (cons (protect u) ())) (cons (cons sym (cons (protect x) ())) ()))) ()))))) + +(register-rule (rule (cons (cons sym (cons (protect D) ())) (cons (cons (cons sym (cons (protect Cos) ())) (cons (cons named (cons (protect u) (cons (cons blank ()) ()))) ())) (cons (cons named (cons (protect x) (cons (cons blank ()) ()))) ()))) (cons (cons sym (cons (protect Times) ())) (cons (cons int (cons -1 ())) (cons (cons (cons sym (cons (protect Sin) ())) (cons (cons sym (cons (protect u) ())) ())) (cons (cons (cons sym (cons (protect D) ())) (cons (cons sym (cons (protect u) ())) (cons (cons sym (cons (protect x) ())) ()))) ())))))) + +(register-rule (rule (cons (cons sym (cons (protect D) ())) (cons (cons (cons sym (cons (protect Exp) ())) (cons (cons named (cons (protect u) (cons (cons blank ()) ()))) ())) (cons (cons named (cons (protect x) (cons (cons blank ()) ()))) ()))) (cons (cons sym (cons (protect Times) ())) (cons (cons (cons sym (cons (protect Exp) ())) (cons (cons sym (cons (protect u) ())) ())) (cons (cons (cons sym (cons (protect D) ())) (cons (cons sym (cons (protect u) ())) (cons (cons sym (cons (protect x) ())) ()))) ()))))) + +(register-rule (rule (cons (cons sym (cons (protect D) ())) (cons (cons (cons sym (cons (protect Log) ())) (cons (cons named (cons (protect u) (cons (cons blank ()) ()))) ())) (cons (cons named (cons (protect x) (cons (cons blank ()) ()))) ()))) (cons (cons sym (cons (protect Times) ())) (cons (cons (cons sym (cons (protect Power) ())) (cons (cons sym (cons (protect u) ())) (cons (cons int (cons -1 ())) ()))) (cons (cons (cons sym (cons (protect D) ())) (cons (cons sym (cons (protect u) ())) (cons (cons sym (cons (protect x) ())) ()))) ()))))) + +(register-rule (rule (cons (cons sym (cons (protect D) ())) (cons (cons (cons sym (cons (protect Tan) ())) (cons (cons named (cons (protect u) (cons (cons blank ()) ()))) ())) (cons (cons named (cons (protect x) (cons (cons blank ()) ()))) ()))) (cons (cons sym (cons (protect Times) ())) (cons (cons (cons sym (cons (protect Power) ())) (cons (cons (cons sym (cons (protect Sec) ())) (cons (cons sym (cons (protect u) ())) ())) (cons (cons int (cons 2 ())) ()))) (cons (cons (cons sym (cons (protect D) ())) (cons (cons sym (cons (protect u) ())) (cons (cons sym (cons (protect x) ())) ()))) ()))))) + +(register-rule (rule (cons (cons sym (cons (protect D) ())) (cons (cons (cons sym (cons (protect Sqrt) ())) (cons (cons named (cons (protect u) (cons (cons blank ()) ()))) ())) (cons (cons named (cons (protect x) (cons (cons blank ()) ()))) ()))) (cons (cons sym (cons (protect D) ())) (cons (cons (cons sym (cons (protect Power) ())) (cons (cons sym (cons (protect u) ())) (cons (cons rat (cons 1 (cons 2 ()))) ()))) (cons (cons sym (cons (protect x) ())) ()))))) + +(register-rule (rule (cons (cons sym (cons (protect D) ())) (cons (cons (cons sym (cons (protect ArcTan) ())) (cons (cons named (cons (protect u) (cons (cons blank ()) ()))) ())) (cons (cons named (cons (protect x) (cons (cons blank ()) ()))) ()))) (cons (cons sym (cons (protect Times) ())) (cons (cons (cons sym (cons (protect Power) ())) (cons (cons (cons sym (cons (protect Plus) ())) (cons (cons int (cons 1 ())) (cons (cons (cons sym (cons (protect Power) ())) (cons (cons sym (cons (protect u) ())) (cons (cons int (cons 2 ())) ()))) ()))) (cons (cons int (cons -1 ())) ()))) (cons (cons (cons sym (cons (protect D) ())) (cons (cons sym (cons (protect u) ())) (cons (cons sym (cons (protect x) ())) ()))) ()))))) + +(register-rule (rule (cons (cons sym (cons (protect D) ())) (cons (cons (cons sym (cons (protect ArcSin) ())) (cons (cons named (cons (protect u) (cons (cons blank ()) ()))) ())) (cons (cons named (cons (protect x) (cons (cons blank ()) ()))) ()))) (cons (cons sym (cons (protect Times) ())) (cons (cons (cons sym (cons (protect Power) ())) (cons (cons (cons sym (cons (protect Plus) ())) (cons (cons int (cons 1 ())) (cons (cons (cons sym (cons (protect Times) ())) (cons (cons int (cons -1 ())) (cons (cons (cons sym (cons (protect Power) ())) (cons (cons sym (cons (protect u) ())) (cons (cons int (cons 2 ())) ()))) ()))) ()))) (cons (cons rat (cons -1 (cons 2 ()))) ()))) (cons (cons (cons sym (cons (protect D) ())) (cons (cons sym (cons (protect u) ())) (cons (cons sym (cons (protect x) ())) ()))) ()))))) + +(register-rule (rule (cons (cons sym (cons (protect D) ())) (cons (cons (cons sym (cons (protect ArcCos) ())) (cons (cons named (cons (protect u) (cons (cons blank ()) ()))) ())) (cons (cons named (cons (protect x) (cons (cons blank ()) ()))) ()))) (cons (cons sym (cons (protect Times) ())) (cons (cons int (cons -1 ())) (cons (cons (cons sym (cons (protect Power) ())) (cons (cons (cons sym (cons (protect Plus) ())) (cons (cons int (cons 1 ())) (cons (cons (cons sym (cons (protect Times) ())) (cons (cons int (cons -1 ())) (cons (cons (cons sym (cons (protect Power) ())) (cons (cons sym (cons (protect u) ())) (cons (cons int (cons 2 ())) ()))) ()))) ()))) (cons (cons rat (cons -1 (cons 2 ()))) ()))) (cons (cons (cons sym (cons (protect D) ())) (cons (cons sym (cons (protect u) ())) (cons (cons sym (cons (protect x) ())) ()))) ())))))) + +(register-rule (rule (cons (cons sym (cons (protect D) ())) (cons (cons (cons sym (cons (protect Sec) ())) (cons (cons named (cons (protect u) (cons (cons blank ()) ()))) ())) (cons (cons named (cons (protect x) (cons (cons blank ()) ()))) ()))) (cons (cons sym (cons (protect Times) ())) (cons (cons (cons sym (cons (protect Sec) ())) (cons (cons sym (cons (protect u) ())) ())) (cons (cons (cons sym (cons (protect Tan) ())) (cons (cons sym (cons (protect u) ())) ())) (cons (cons (cons sym (cons (protect D) ())) (cons (cons sym (cons (protect u) ())) (cons (cons sym (cons (protect x) ())) ()))) ())))))) + +(if (= (make-rat 6 4) (cons rat (cons 3 (cons 2 ())))) (pr "SCUD 21: rational tower verified (make-rat 6 4 = [rat 3 2]). +" (stoutput)) (simple-error "SCUD 21 integration requires the rational tower (make-rat) -- not wired")) + +(register-rule (rule (cons condition (cons (cons (cons sym (cons (protect Integrate) ())) (cons (cons (cons sym (cons (protect Power) ())) (cons (cons named (cons (protect u) (cons (cons blank ()) ()))) (cons (cons int (cons -1 ())) ()))) (cons (cons named (cons (protect x) (cons (cons blank ()) ()))) ()))) (cons (cons (cons sym (cons (protect SameQ) ())) (cons (cons sym (cons (protect u) ())) (cons (cons sym (cons (protect x) ())) ()))) ()))) (cons (cons sym (cons (protect Log) ())) (cons (cons sym (cons (protect x) ())) ())))) + +(register-rule (rule (cons condition (cons (cons (cons sym (cons (protect Integrate) ())) (cons (cons (cons sym (cons (protect Sin) ())) (cons (cons named (cons (protect u) (cons (cons blank ()) ()))) ())) (cons (cons named (cons (protect x) (cons (cons blank ()) ()))) ()))) (cons (cons (cons sym (cons (protect SameQ) ())) (cons (cons sym (cons (protect u) ())) (cons (cons sym (cons (protect x) ())) ()))) ()))) (cons (cons sym (cons (protect Times) ())) (cons (cons int (cons -1 ())) (cons (cons (cons sym (cons (protect Cos) ())) (cons (cons sym (cons (protect x) ())) ())) ()))))) + +(register-rule (rule (cons condition (cons (cons (cons sym (cons (protect Integrate) ())) (cons (cons (cons sym (cons (protect Cos) ())) (cons (cons named (cons (protect u) (cons (cons blank ()) ()))) ())) (cons (cons named (cons (protect x) (cons (cons blank ()) ()))) ()))) (cons (cons (cons sym (cons (protect SameQ) ())) (cons (cons sym (cons (protect u) ())) (cons (cons sym (cons (protect x) ())) ()))) ()))) (cons (cons sym (cons (protect Sin) ())) (cons (cons sym (cons (protect x) ())) ())))) + +(register-rule (rule (cons condition (cons (cons (cons sym (cons (protect Integrate) ())) (cons (cons (cons sym (cons (protect Exp) ())) (cons (cons named (cons (protect u) (cons (cons blank ()) ()))) ())) (cons (cons named (cons (protect x) (cons (cons blank ()) ()))) ()))) (cons (cons (cons sym (cons (protect SameQ) ())) (cons (cons sym (cons (protect u) ())) (cons (cons sym (cons (protect x) ())) ()))) ()))) (cons (cons sym (cons (protect Exp) ())) (cons (cons sym (cons (protect x) ())) ())))) + +(register-rule (rule (cons condition (cons (cons (cons sym (cons (protect Integrate) ())) (cons (cons (cons sym (cons (protect Power) ())) (cons (cons named (cons (protect u) (cons (cons blank ()) ()))) (cons (cons named (cons (protect n) (cons (cons blank ()) ()))) ()))) (cons (cons named (cons (protect x) (cons (cons blank ()) ()))) ()))) (cons (cons (cons sym (cons (protect And) ())) (cons (cons (cons sym (cons (protect SameQ) ())) (cons (cons sym (cons (protect u) ())) (cons (cons sym (cons (protect x) ())) ()))) (cons (cons (cons sym (cons (protect And) ())) (cons (cons (cons sym (cons (protect FreeQ) ())) (cons (cons sym (cons (protect n) ())) (cons (cons sym (cons (protect x) ())) ()))) (cons (cons (cons sym (cons (protect UnsameQ) ())) (cons (cons sym (cons (protect n) ())) (cons (cons int (cons -1 ())) ()))) ()))) ()))) ()))) (cons (cons sym (cons (protect Times) ())) (cons (cons (cons sym (cons (protect Power) ())) (cons (cons sym (cons (protect x) ())) (cons (cons (cons sym (cons (protect Plus) ())) (cons (cons sym (cons (protect n) ())) (cons (cons int (cons 1 ())) ()))) ()))) (cons (cons (cons sym (cons (protect Power) ())) (cons (cons (cons sym (cons (protect Plus) ())) (cons (cons sym (cons (protect n) ())) (cons (cons int (cons 1 ())) ()))) (cons (cons int (cons -1 ())) ()))) ()))))) + +(register-rule (rule (cons condition (cons (cons (cons sym (cons (protect Integrate) ())) (cons (cons named (cons (protect u) (cons (cons blank ()) ()))) (cons (cons named (cons (protect x) (cons (cons blank ()) ()))) ()))) (cons (cons (cons sym (cons (protect SameQ) ())) (cons (cons sym (cons (protect u) ())) (cons (cons sym (cons (protect x) ())) ()))) ()))) (cons (cons sym (cons (protect Times) ())) (cons (cons (cons sym (cons (protect Power) ())) (cons (cons sym (cons (protect x) ())) (cons (cons int (cons 2 ())) ()))) (cons (cons rat (cons 1 (cons 2 ()))) ()))))) + +(register-rule (rule (cons (cons sym (cons (protect Integrate) ())) (cons (cons (cons sym (cons (protect Plus) ())) (cons (cons named (cons (protect a) (cons (cons blank ()) ()))) (cons (cons named (cons (protect r) (cons (cons blank-seq ()) ()))) ()))) (cons (cons named (cons (protect x) (cons (cons blank ()) ()))) ()))) (cons (cons sym (cons (protect Plus) ())) (cons (cons (cons sym (cons (protect Integrate) ())) (cons (cons sym (cons (protect a) ())) (cons (cons sym (cons (protect x) ())) ()))) (cons (cons (cons sym (cons (protect Integrate) ())) (cons (cons (cons sym (cons (protect Plus) ())) (cons (cons sym (cons (protect r) ())) ())) (cons (cons sym (cons (protect x) ())) ()))) ()))))) + +(register-rule (rule (cons condition (cons (cons (cons sym (cons (protect Integrate) ())) (cons (cons (cons sym (cons (protect Times) ())) (cons (cons named (cons (protect c) (cons (cons blank ()) ()))) (cons (cons named (cons (protect f) (cons (cons blank-seq ()) ()))) ()))) (cons (cons named (cons (protect x) (cons (cons blank ()) ()))) ()))) (cons (cons (cons sym (cons (protect FreeQ) ())) (cons (cons sym (cons (protect c) ())) (cons (cons sym (cons (protect x) ())) ()))) ()))) (cons (cons sym (cons (protect Times) ())) (cons (cons sym (cons (protect c) ())) (cons (cons (cons sym (cons (protect Integrate) ())) (cons (cons (cons sym (cons (protect Times) ())) (cons (cons sym (cons (protect f) ())) ())) (cons (cons sym (cons (protect x) ())) ()))) ()))))) + +(register-rule (rule (cons condition (cons (cons (cons sym (cons (protect Integrate) ())) (cons (cons named (cons (protect c) (cons (cons blank ()) ()))) (cons (cons named (cons (protect x) (cons (cons blank ()) ()))) ()))) (cons (cons (cons sym (cons (protect FreeQ) ())) (cons (cons sym (cons (protect c) ())) (cons (cons sym (cons (protect x) ())) ()))) ()))) (cons (cons sym (cons (protect Times) ())) (cons (cons sym (cons (protect c) ())) (cons (cons sym (cons (protect x) ())) ()))))) + +(pr "boot/calculus.shen loaded (D + bounded Integrate rule library). +" (stoutput)) + +(defun reduce-ref (V5563) (reduce-db (value *db*) V5563)) + +(defun normal-form-ref (V5564) (normal-form-db (value *db*) V5564)) + +(defun reduce-compiled (V5565) V5565) + +(defun normal-form-compiled (V5566) V5566) + +(set *current-core* ref) + +(defun current-core () (value *current-core*)) + +(defun set-current-core (V5567) (set *current-core* V5567)) + +(defun reduce-via (V5570 V5571) (cond ((= ref V5570) (reduce-ref V5571)) ((= compiled V5570) (reduce-compiled V5571)) (true (reduce-ref V5571)))) + +(defun normal-form-via (V5574 V5575) (cond ((= ref V5574) (normal-form-ref V5575)) ((= compiled V5574) (normal-form-compiled V5575)) (true (normal-form-ref V5575)))) + +(set *max-eval-steps* 1000) + +(set *listable-on* false) + +(defun rules-for-expr (V5576 V5577) (if (and (cons? V5576) (not (empty? (db-datoms V5576)))) (dispatch-candidates V5576 V5577) ())) + +(defun reduce-args (V5578 V5579) (if (expr-compound? V5579) (reduce-args-compound V5578 V5579) V5579)) + +(defun reduce-args-compound (V5580 V5581) (cond ((cons? V5581) (if (sym? (hd V5581)) (let W5582 (sym-name (hd V5581)) (if (holds-all? V5580 W5582) V5581 (if (holds-first? V5580 W5582) (cons (hd V5581) (cons (hd (tl V5581)) (map (lambda Z5583 (reduce-db V5580 Z5583)) (tl (tl V5581))))) (if (holds-rest? V5580 W5582) (cons (hd V5581) (cons (reduce-db V5580 (hd (tl V5581))) (tl (tl V5581)))) (cons (hd V5581) (map (lambda Z5584 (reduce-db V5580 Z5584)) (tl V5581))))))) (cons (hd V5581) (map (lambda Z5585 (reduce-db V5580 Z5585)) (tl V5581))))) (true (simple-error "partial function reduce-args-compound")))) + +(defun canon-flat-orderless (V5586 V5587) (cond ((cons? V5587) (if (sym? (hd V5587)) (let W5588 (sym-name (hd V5587)) (let W5589 (if (has-flat? W5588) (flatten-flat-args (hd V5587) (tl V5587)) (tl V5587)) (let W5590 (if (has-orderless? W5588) (sort-exprs-by-hash W5589) W5589) (cons (hd V5587) W5590)))) V5587)) (true V5587))) + +(defun sort-exprs-by-hash (V5591) (sort-exprs-insert V5591)) + +(defun sort-exprs-insert (V5592) (cond ((= () V5592) ()) ((cons? V5592) (insert-expr-by-hash (hd V5592) (sort-exprs-insert (tl V5592)))) (true (simple-error "partial function sort-exprs-insert")))) + +(defun insert-expr-by-hash (V5593 V5594) (cond ((= () V5594) (cons V5593 ())) ((cons? V5594) (if (<= (unwrap-ch (content-hash V5593)) (unwrap-ch (content-hash (hd V5594)))) (cons V5593 V5594) (cons (hd V5594) (insert-expr-by-hash V5593 (tl V5594))))) (true (simple-error "partial function insert-expr-by-hash")))) + +(defun try-builtin (V5595) (cond ((cons? V5595) (if (sym? (hd V5595)) (apply-builtin-result (builtin-result (hd V5595) (tl V5595)) V5595) V5595)) (true V5595))) + +(defun builtin-result (V5596 V5597) (let W5598 (num-builtin V5596 V5597) (if (= W5598 (cons none ())) (calc-builtin V5596 V5597) W5598))) + +(defun apply-builtin-result (V5603 V5604) (cond ((and (cons? V5603) (and (= some (hd V5603)) (and (cons? (tl V5603)) (= () (tl (tl V5603)))))) (hd (tl V5603))) ((and (cons? V5603) (and (= none (hd V5603)) (= () (tl V5603)))) V5604) (true V5604))) + +(defun up-candidates (V5609 V5610) (cond ((cons? V5610) (up-candidates-for-args V5609 (tl V5610))) (true ()))) + +(defun up-candidates-for-args (V5611 V5612) (cond ((= () V5612) ()) ((cons? V5612) (append (up-candidates-for-arg V5611 (hd V5612)) (up-candidates-for-args V5611 (tl V5612)))) (true (simple-error "partial function up-candidates-for-args")))) + +(defun up-candidates-for-arg (V5617 V5618) (cond ((cons? V5618) (if (sym? (hd V5618)) (up-rules V5617 (sym-name (hd V5618))) ())) (true ()))) + +(defun up-rules (V5619 V5620) (let W5621 (symbol-entry-view V5619 (cons sym (cons V5620 ()))) (hd (tl (tl (tl W5621)))))) + +(defun eval-step (V5622 V5623) (if (block-form? V5623) (reduce-block V5622 V5623) (if (expr-compound? V5623) (eval-step-compound V5622 V5623) V5623))) + +(defun eval-step-compound (V5624 V5625) (let W5626 (reduce-args V5624 V5625) (let W5627 (canon-flat-orderless V5624 W5626) (let W5628 (try-builtin W5627) (if (not (content-eq W5628 W5627)) W5628 (let W5629 (rules-for-expr V5624 W5627) (let W5630 (try-reduce-db V5624 W5627 W5629) (if (not (content-eq W5630 W5627)) W5630 (let W5631 (up-candidates V5624 W5627) (try-reduce-db V5624 W5627 W5631)))))))))) + +(defun reduce-db (V5632 V5633) (reduce-fixpoint V5632 V5633 (value *max-eval-steps*))) + +(defun reduce-fixpoint (V5634 V5635 V5636) (cond ((= 0 V5636) (do (pr (cn "WARNING: *max-eval-steps* exceeded; returning " (shen.app (pretty-expr V5635) " +" shen.a)) (stoutput)) V5635)) (true (let W5637 (eval-step V5634 V5635) (if (content-eq W5637 V5635) W5637 (reduce-fixpoint V5634 W5637 (- V5636 1))))))) + +(set *max-rule-tries* 2000) + +(defun try-reduce-db (V5638 V5639 V5640) (try-reduce-db-fuel V5638 V5639 V5640 (value *max-rule-tries*))) + +(defun try-reduce-db-fuel (V5643 V5644 V5645 V5646) (cond ((= () V5645) V5644) ((and (cons? V5645) (= 0 V5646)) (do (pr (cn "WARNING: *max-rule-tries* exceeded at " (shen.app (pretty-expr V5644) "; leaving inert +" shen.a)) (stoutput)) V5644)) ((cons? V5645) (if (checked-rule? (hd V5645)) (let W5647 (rule-lhs (hd V5645)) (let W5648 (rule-rhs (hd V5645)) (let W5649 (match W5647 V5644) (if (match-some? W5649) (substitute (match-unwrap W5649) W5648) (try-reduce-db-fuel V5643 V5644 (tl V5645) (- V5646 1)))))) (try-reduce-db-fuel V5643 V5644 (tl V5645) (- V5646 1)))) (true (simple-error "partial function try-reduce-db-fuel")))) + +(defun rule-lhs (V5652) (cond ((and (cons? V5652) (and (= rule (hd V5652)) (and (cons? (tl V5652)) (and (cons? (tl (tl V5652))) (= () (tl (tl (tl V5652)))))))) (hd (tl V5652))) (true (simple-error "partial function rule-lhs")))) + +(defun rule-rhs (V5655) (cond ((and (cons? V5655) (and (= rule (hd V5655)) (and (cons? (tl V5655)) (and (cons? (tl (tl V5655))) (= () (tl (tl (tl V5655)))))))) (hd (tl (tl V5655)))) (true (simple-error "partial function rule-rhs")))) + +(defun block-form? (V5662) (cond ((and (cons? V5662) (and (cons? (hd V5662)) (and (= sym (hd (hd V5662))) (and (cons? (tl (hd V5662))) (and (= block (hd (tl (hd V5662)))) (and (= () (tl (tl (hd V5662)))) (and (cons? (tl V5662)) (and (cons? (tl (tl V5662))) (= () (tl (tl (tl V5662)))))))))))) true) (true false))) + +(defun reduce-block (V5663 V5664) (cond ((and (cons? V5664) (and (cons? (hd V5664)) (and (= sym (hd (hd V5664))) (and (cons? (tl (hd V5664))) (and (= block (hd (tl (hd V5664)))) (and (= () (tl (tl (hd V5664)))) (and (cons? (tl V5664)) (and (cons? (tl (tl V5664))) (= () (tl (tl (tl V5664)))))))))))) (let W5665 (apply-block-binds V5663 (hd (tl V5664))) (reduce-db W5665 (hd (tl (tl V5664)))))) (true V5664))) + +(defun apply-block-binds (V5668 V5669) (cond ((= () V5669) V5668) ((and (cons? V5669) (and (cons? (hd V5669)) (and (cons? (hd (hd V5669))) (and (= sym (hd (hd (hd V5669)))) (and (cons? (tl (hd (hd V5669)))) (and (= block-bind (hd (tl (hd (hd V5669))))) (and (= () (tl (tl (hd (hd V5669))))) (and (cons? (tl (hd V5669))) (and (cons? (tl (tl (hd V5669)))) (= () (tl (tl (tl (hd V5669)))))))))))))) (let W5670 (cons (hd (tl (hd V5669))) (cons own (cons (make-rule-datum (cons sym (cons (hd (tl (hd V5669))) ())) (hd (tl (tl (hd V5669))))) (cons (db-size V5668) ())))) (let W5671 (db-fork-with V5668 (cons W5670 ())) (apply-block-binds W5671 (tl V5669))))) (true V5668))) + +(defun reduce (V5672) (reduce-via (current-core) V5672)) + +(defun normal-form-db (V5673 V5674) (let W5675 (content-hash V5674) (let W5676 (db-basis V5673) (let W5677 (nf-cache-key W5675 W5676) (let W5678 (nf-lookup W5677) (if (assoc-hit? W5678) (hd (tl W5678)) (let W5679 (reduce-db V5673 V5674) (let W5680 (nf-store! W5677 W5679) W5679)))))))) + +(defun normal-form (V5681) (normal-form-via (current-core) V5681)) + +(defun demo-register-arith () (do (load "boot/arith.shen") true)) + +(defun demo-register-simplify () (do (demo-register-arith) (do (load "boot/simplify.shen") true))) + +(defun demo-register-calculus () (do (demo-register-simplify) (do (load "boot/elemfun.shen") (do (load "boot/calculus.shen") true)))) + +(defun demo-reduce (V5682) (let W5683 (demo-register-arith) (reduce V5682))) + +(pr "core.shen (eval-step fixpoint evaluator + arith hook + seam) loaded. +" (stoutput)) + +(set *gensym-counter* 0) + +(defun cas-gensym (V5684) (let W5685 (value *gensym-counter*) (let W5686 (set *gensym-counter* (+ W5685 1)) (intern (cn (str V5684) (cn "$" (str W5685))))))) + +(defun ensure-bare-symbol (V5687) (cond ((symbol? V5687) V5687) ((and (cons? V5687) (and (= sym (hd V5687)) (and (cons? (tl V5687)) (= () (tl (tl V5687)))))) (hd (tl V5687))) (true (simple-error (cn "scope: binder must be symbol (not " (shen.app V5687 ")" shen.s)))))) + +(defun generate-canon-bare (V5688) (cond ((= 0 V5688) ()) (true (generate-canon-bare-helper 0 V5688)))) + +(defun generate-canon-bare-helper (V5689 V5690) (cond ((>= V5689 V5690) ()) (true (cons (intern (cn "G$" (str V5689))) (generate-canon-bare-helper (+ V5689 1) V5690))))) + +(defun rename-in-expr (V5695 V5696 V5697) (cond ((and (= () V5695) (= () V5696)) V5697) ((and (cons? V5695) (cons? V5696)) (rename-in-expr (tl V5695) (tl V5696) (rename-one (hd V5695) (hd V5696) V5697))) (true V5697))) + +(defun rename-one (V5698 V5699 V5700) (cond ((and (cons? V5700) (and (= sym (hd V5700)) (and (cons? (tl V5700)) (and (= () (tl (tl V5700))) (= (hd (tl V5700)) V5698))))) (cons sym (cons V5699 ()))) ((and (symbol? V5700) (= V5700 V5698)) V5699) ((and (cons? V5700) (and (= int (hd V5700)) (and (cons? (tl V5700)) (= () (tl (tl V5700)))))) V5700) ((cons? V5700) (cons (rename-one V5698 V5699 (hd V5700)) (map (lambda Z5701 (rename-one V5698 V5699 Z5701)) (tl V5700)))) (true V5700))) + +(defun scope-alpha-canonicalize (V5702) (cond ((and (cons? V5702) (and (cons? (hd V5702)) (and (= sym (hd (hd V5702))) (and (cons? (tl (hd V5702))) (and (= module (hd (tl (hd V5702)))) (and (= () (tl (tl (hd V5702)))) (and (cons? (tl V5702)) (and (cons? (tl (tl V5702))) (= () (tl (tl (tl V5702)))))))))))) (let W5703 (map (lambda Z5704 (ensure-bare-symbol Z5704)) (hd (tl V5702))) (let W5705 (generate-canon-bare (length W5703)) (let W5706 (scope-alpha-canonicalize (rename-in-expr W5703 W5705 (hd (tl (tl V5702))))) (cons (hd V5702) (cons W5705 (cons W5706 ()))))))) ((and (cons? V5702) (and (cons? (hd V5702)) (and (= sym (hd (hd V5702))) (and (cons? (tl (hd V5702))) (and (= with (hd (tl (hd V5702)))) (and (= () (tl (tl (hd V5702)))) (and (cons? (tl V5702)) (and (cons? (tl (tl V5702))) (and (cons? (tl (tl (tl V5702)))) (= () (tl (tl (tl (tl V5702)))))))))))))) (let W5707 (ensure-bare-symbol (hd (tl V5702))) (let W5708 (hd (generate-canon-bare 1)) (let W5709 (scope-alpha-canonicalize (rename-in-expr (cons W5707 ()) (cons W5708 ()) (hd (tl (tl (tl V5702)))))) (cons (hd V5702) (cons W5708 (cons (hd (tl (tl V5702))) (cons W5709 ())))))))) ((cons? V5702) (cons (scope-alpha-canonicalize (hd V5702)) (map (lambda Z5710 (scope-alpha-canonicalize Z5710)) (tl V5702)))) (true V5702))) + +(defun alpha-canonicalize (V5711) (scope-alpha-canonicalize V5711)) + +(defun module (V5712 V5713) (let W5714 (map (lambda Z5715 (ensure-bare-symbol Z5715)) V5712) (let W5716 (generate-canon-bare (length W5714)) (let W5717 (alpha-canonicalize (rename-in-expr W5714 W5716 V5713)) (alpha-canonicalize (cons (cons sym (cons module ())) (cons W5716 (cons W5717 ())))))))) + +(defun with (V5718 V5719 V5720) (let W5721 (ensure-bare-symbol V5718) (let W5722 (hd (generate-canon-bare 1)) (let W5723 (alpha-canonicalize (rename-in-expr (cons W5721 ()) (cons W5722 ()) V5720)) (alpha-canonicalize (cons (cons sym (cons with ())) (cons W5722 (cons V5719 (cons W5723 ()))))))))) + +(defun block-bind (V5724 V5725) (if (symbol? V5724) (cons (cons sym (cons block-bind ())) (cons V5724 (cons V5725 ()))) (simple-error "block-bind: symbol only"))) + +(defun block-bind? (V5730) (cond ((and (cons? V5730) (and (cons? (hd V5730)) (and (= sym (hd (hd V5730))) (and (cons? (tl (hd V5730))) (and (= block-bind (hd (tl (hd V5730)))) (and (= () (tl (tl (hd V5730)))) (and (cons? (tl V5730)) (and (cons? (tl (tl V5730))) (= () (tl (tl (tl V5730)))))))))))) (symbol? (hd (tl V5730)))) (true false))) + +(defun block-bindings-ok? (V5735) (cond ((= () V5735) true) ((and (cons? V5735) (and (cons? (hd V5735)) (and (cons? (hd (hd V5735))) (and (= sym (hd (hd (hd V5735)))) (and (cons? (tl (hd (hd V5735)))) (and (= block-bind (hd (tl (hd (hd V5735))))) (and (= () (tl (tl (hd (hd V5735))))) (and (cons? (tl (hd V5735))) (and (cons? (tl (tl (hd V5735)))) (= () (tl (tl (tl (hd V5735)))))))))))))) (if (symbol? (hd (tl (hd V5735)))) (block-bindings-ok? (tl V5735)) false)) (true (simple-error "block-binding: only symbols allowed in binding position")))) + +(defun block (V5736 V5737) (if (block-bindings-ok? V5736) (cons (cons sym (cons block ())) (cons V5736 (cons V5737 ()))) (simple-error "block: non-symbol in binding position"))) + +(defun module? (V5744) (cond ((and (cons? V5744) (and (cons? (hd V5744)) (and (= sym (hd (hd V5744))) (and (cons? (tl (hd V5744))) (and (= module (hd (tl (hd V5744)))) (and (= () (tl (tl (hd V5744)))) (and (cons? (tl V5744)) (and (cons? (tl (tl V5744))) (= () (tl (tl (tl V5744)))))))))))) true) (true false))) + +(defun with? (V5753) (cond ((and (cons? V5753) (and (cons? (hd V5753)) (and (= sym (hd (hd V5753))) (and (cons? (tl (hd V5753))) (and (= with (hd (tl (hd V5753)))) (and (= () (tl (tl (hd V5753)))) (and (cons? (tl V5753)) (and (cons? (tl (tl V5753))) (and (cons? (tl (tl (tl V5753)))) (= () (tl (tl (tl (tl V5753)))))))))))))) true) (true false))) + +(defun block? (V5760) (cond ((and (cons? V5760) (and (cons? (hd V5760)) (and (= sym (hd (hd V5760))) (and (cons? (tl (hd V5760))) (and (= block (hd (tl (hd V5760)))) (and (= () (tl (tl (hd V5760)))) (and (cons? (tl V5760)) (and (cons? (tl (tl V5760))) (= () (tl (tl (tl V5760)))))))))))) true) (true false))) + +(pr "scope.shen (stub: Module/With/Block + hygienic gensym + alpha-for-hash tie + symbol-only block check). +" (stoutput)) + +(defun digit? (V5761) (let W5762 (string->n V5761) (and (>= W5762 48) (<= W5762 57)))) + +(defun letter? (V5763) (let W5764 (string->n V5763) (or (and (>= W5764 65) (<= W5764 90)) (and (>= W5764 97) (<= W5764 122))))) + +(defun alnum? (V5765) (or (letter? V5765) (digit? V5765))) + +(defun tokenize (V5766) (tok V5766 ())) + +(defun tok (V5767 V5768) (cond ((= "" V5767) (reverse V5768)) (true (let W5769 (pos V5767 0) (let W5770 (tlstr V5767) (cond ((= W5769 " ") (tok W5770 V5768)) ((= W5769 " ") (tok W5770 V5768)) ((= W5769 " +") (tok W5770 V5768)) ((= W5769 "[") (tok W5770 (cons lbrack V5768))) ((= W5769 "]") (tok W5770 (cons rbrack V5768))) ((= W5769 "(") (tok W5770 (cons lparen V5768))) ((= W5769 ")") (tok W5770 (cons rparen V5768))) ((= W5769 ",") (tok W5770 (cons comma V5768))) ((= W5769 "+") (tok W5770 (cons plus V5768))) ((= W5769 "*") (tok W5770 (cons star V5768))) ((= W5769 "^") (tok W5770 (cons pow V5768))) ((= W5769 "/") (tok W5770 (cons slash V5768))) ((= W5769 ":") (tok-colon V5767 V5768)) ((= W5769 "=") (tok-eq V5767 V5768)) ((= W5769 "_") (tok-blank V5767 0 V5768)) ((= W5769 "-") (tok W5770 (cons dash V5768))) ((digit? W5769) (tok-num V5767 0 V5768)) ((letter? W5769) (tok-id V5767 "" V5768)) (true (simple-error (cn "tokenize: bad char " (shen.app W5769 "" shen.a)))))))))) + +(defun tok-colon (V5771 V5772) (let W5773 (tlstr V5771) (if (and (not (= W5773 "")) (= (pos W5773 0) "=")) (tok (tlstr W5773) (cons colon-eq V5772)) (simple-error "tokenize: bare ':' (expected :=)")))) + +(defun tok-eq (V5774 V5775) (let W5776 (tlstr V5774) (if (and (not (= W5776 "")) (= (pos W5776 0) "=")) (tok (tlstr W5776) (cons eqeq V5775)) (simple-error "tokenize: bare '=' (expected ==)")))) + +(defun tok-num (V5777 V5778 V5779) (if (or (= V5777 "") (not (digit? (pos V5777 0)))) (tok V5777 (cons (cons num (cons V5778 ())) V5779)) (tok-num (tlstr V5777) (+ (* V5778 10) (- (string->n (pos V5777 0)) 48)) V5779))) + +(defun tok-id (V5780 V5781 V5782) (if (or (= V5780 "") (not (alnum? (pos V5780 0)))) (tok V5780 (cons (cons id (cons V5781 ())) V5782)) (tok-id (tlstr V5780) (@s V5781 (pos V5780 0)) V5782))) + +(defun tok-blank (V5783 V5784 V5785) (if (and (not (= V5783 "")) (= (pos V5783 0) "_")) (tok-blank (tlstr V5783) (+ V5784 1) V5785) (tok V5783 (cons (blank-token V5784) V5785)))) + +(defun blank-token (V5786) (cond ((= 1 V5786) blank1) ((= 2 V5786) blank2) ((= 3 V5786) blank3) (true (simple-error (cn "tokenize: " (shen.app V5786 " underscores (only _ __ ___)" shen.a)))))) + +(defun sym* (V5787) (sym (intern V5787))) + +(defun int* (V5788) (cas-intern! (cons int (cons V5788 ())))) + +(defun compound* (V5789 V5790) (cons V5789 V5790)) + +(defun blank-pat () (cons blank ())) + +(defun blank-seq-pat () (cons blank-seq ())) + +(defun blank-null-pat () (cons blank-null-seq ())) + +(defun named-pat (V5791 V5792) (cons named (cons V5791 (cons V5792 ())))) + +(defun make-rule (V5793 V5794) (rule V5793 V5794)) + +(defun prec (V5797) (cond ((= eqeq V5797) 1) ((= plus V5797) 2) ((= dash V5797) 2) ((= star V5797) 3) ((= slash V5797) 3) ((= pow V5797) 4) (true 0))) + +(defun left-assoc? (V5798) (or (= V5798 eqeq) (or (= V5798 plus) (or (= V5798 dash) (or (= V5798 star) (= V5798 slash)))))) + +(defun parse-expr-string (V5799) (let W5800 (tokenize V5799) (let W5801 (p-expr W5800 0) (let W5802 (hd W5801) (let W5803 (tl W5801) (if (empty? W5803) W5802 (simple-error (cn "parse-expr: trailing tokens after " (shen.app W5802 (cn " : " (shen.app W5803 "" shen.a)) shen.a))))))))) + +(defun p-expr (V5804 V5805) (let W5806 (p-factor V5804) (let W5807 (hd W5806) (let W5808 (tl W5806) (p-infix W5807 W5808 V5805))))) + +(defun p-infix (V5813 V5814 V5815) (cond ((= () V5814) (cons V5813 ())) ((cons? V5814) (if (infix-op? (hd V5814)) (let W5816 (prec (hd V5814)) (if (not (>= W5816 V5815)) (cons V5813 V5814) (let W5817 (if (left-assoc? (hd V5814)) (+ W5816 1) W5816) (let W5818 (p-expr (tl V5814) W5817) (let W5819 (hd W5818) (let W5820 (tl W5818) (let W5821 (make-infix-expr (hd V5814) V5813 W5819) (p-infix W5821 W5820 V5815)))))))) (if (factor-start? (hd V5814)) (let W5822 (prec star) (if (not (>= W5822 V5815)) (cons V5813 V5814) (let W5823 (p-expr V5814 (+ W5822 1)) (let W5824 (hd W5823) (let W5825 (tl W5823) (let W5826 (make-infix-expr star V5813 W5824) (p-infix W5826 W5825 V5815))))))) (cons V5813 V5814)))) (true (cons V5813 V5814)))) + +(defun factor-start? (V5833) (cond ((and (cons? V5833) (and (= num (hd V5833)) (and (cons? (tl V5833)) (= () (tl (tl V5833)))))) true) ((and (cons? V5833) (and (= id (hd V5833)) (and (cons? (tl V5833)) (= () (tl (tl V5833)))))) true) ((= lparen V5833) true) (true false))) + +(defun infix-op? (V5836) (cond ((= eqeq V5836) true) ((= plus V5836) true) ((= dash V5836) true) ((= star V5836) true) ((= slash V5836) true) ((= pow V5836) true) (true false))) + +(defun make-infix-expr (V5839 V5840 V5841) (cond ((= eqeq V5839) (compound* (sym* "Equal") (cons V5840 (cons V5841 ())))) ((= plus V5839) (compound* (sym* "Plus") (cons V5840 (cons V5841 ())))) ((= dash V5839) (compound* (sym* "Plus") (cons V5840 (cons (negate V5841) ())))) ((= star V5839) (compound* (sym* "Times") (cons V5840 (cons V5841 ())))) ((= slash V5839) (slash-expr V5840 V5841)) ((= pow V5839) (compound* (sym* "Power") (cons V5840 (cons V5841 ())))) (true (simple-error "bad infix")))) + +(defun negate (V5842) (cond ((and (cons? V5842) (and (= int (hd V5842)) (and (cons? (tl V5842)) (= () (tl (tl V5842)))))) (int* (* -1 (hd (tl V5842))))) ((and (cons? V5842) (and (= rat (hd V5842)) (and (cons? (tl V5842)) (and (cons? (tl (tl V5842))) (= () (tl (tl (tl V5842)))))))) (make-rat (* -1 (hd (tl V5842))) (hd (tl (tl V5842))))) (true (negate-compound V5842)))) + +(defun negate-compound (V5843) (if (times-headed? V5843) (negate-times V5843) (compound* (sym* "Times") (cons (int* -1) (cons V5843 ()))))) + +(defun times-headed? (V5848) (cond ((cons? V5848) (if (sym? (hd V5848)) (= (sym-name (hd V5848)) (intern "Times")) false)) (true false))) + +(defun negate-times (V5849) (cond ((and (cons? V5849) (cons? (tl V5849))) (if (numeric? (hd (tl V5849))) (compound* (hd V5849) (cons (negate (hd (tl V5849))) (tl (tl V5849)))) (compound* (hd V5849) (cons (int* -1) (tl V5849))))) (true (simple-error "partial function negate-times")))) + +(defun slash-expr (V5850 V5851) (cond ((and (cons? V5850) (and (= int (hd V5850)) (and (cons? (tl V5850)) (and (= () (tl (tl V5850))) (and (cons? V5851) (and (= int (hd V5851)) (and (cons? (tl V5851)) (= () (tl (tl V5851)))))))))) (make-rat (hd (tl V5850)) (hd (tl V5851)))) (true (compound* (sym* "Divide") (cons V5850 (cons V5851 ())))))) + +(defun p-factor (V5852) (cond ((and (cons? V5852) (= dash (hd V5852))) (let W5853 (p-expr (tl V5852) 4) (let W5854 (hd W5853) (let W5855 (tl W5853) (cons (negate W5854) W5855))))) ((and (cons? V5852) (and (cons? (hd V5852)) (and (= num (hd (hd V5852))) (and (cons? (tl (hd V5852))) (= () (tl (tl (hd V5852)))))))) (cons (int* (hd (tl (hd V5852)))) (tl V5852))) ((and (cons? V5852) (and (cons? (hd V5852)) (and (= id (hd (hd V5852))) (and (cons? (tl (hd V5852))) (and (= () (tl (tl (hd V5852)))) (and (cons? (tl V5852)) (= lbrack (hd (tl V5852))))))))) (let W5856 (p-arglist (tl (tl V5852))) (let W5857 (hd W5856) (let W5858 (tl W5856) (let W5859 (sym* (hd (tl (hd V5852)))) (let W5860 (compound* W5859 W5857) (if (and (cons? W5858) (= (hd W5858) rbrack)) (cons W5860 (tl W5858)) (simple-error (cn "missing ] after app " (shen.app (hd (tl (hd V5852))) "" shen.a)))))))))) ((and (cons? V5852) (and (cons? (hd V5852)) (and (= id (hd (hd V5852))) (and (cons? (tl (hd V5852))) (= () (tl (tl (hd V5852)))))))) (cons (sym* (hd (tl (hd V5852)))) (tl V5852))) ((and (cons? V5852) (= lparen (hd V5852))) (let W5861 (p-expr (tl V5852) 0) (let W5862 (hd W5861) (let W5863 (tl W5861) (if (and (cons? W5863) (= (hd W5863) rparen)) (cons W5862 (tl W5863)) (simple-error "missing ) ")))))) (true (simple-error (cn "p-factor unexpected: " (shen.app V5852 "" shen.a)))))) + +(defun p-arglist (V5864) (cond ((and (cons? V5864) (= rbrack (hd V5864))) (cons () V5864)) (true (let W5865 (p-expr V5864 0) (let W5866 (hd W5865) (let W5867 (tl W5865) (let W5868 (p-arglist-tail W5867) (let W5869 (hd W5868) (let W5870 (tl W5868) (cons (cons W5866 W5869) W5870)))))))))) + +(defun p-arglist-tail (V5871) (cond ((and (cons? V5871) (= comma (hd V5871))) (let W5872 (p-expr (tl V5871) 0) (let W5873 (hd W5872) (let W5874 (tl W5872) (let W5875 (p-arglist-tail W5874) (let W5876 (hd W5875) (let W5877 (tl W5875) (cons (cons W5873 W5876) W5877)))))))) (true (cons () V5871)))) + +(defun parse-pattern-string (V5878) (let W5879 (tokenize V5878) (let W5880 (p-pat W5879) (let W5881 (hd W5880) (let W5882 (tl W5880) (if (empty? W5882) W5881 (simple-error (cn "parse-pattern: trailing " (shen.app W5882 "" shen.a))))))))) + +(defun p-pat (V5883) (cond ((and (cons? V5883) (and (cons? (hd V5883)) (and (= id (hd (hd V5883))) (and (cons? (tl (hd V5883))) (and (= () (tl (tl (hd V5883)))) (and (cons? (tl V5883)) (= blank1 (hd (tl V5883))))))))) (cons (named-pat (intern (hd (tl (hd V5883)))) (blank-pat)) (tl (tl V5883)))) ((and (cons? V5883) (and (cons? (hd V5883)) (and (= id (hd (hd V5883))) (and (cons? (tl (hd V5883))) (and (= () (tl (tl (hd V5883)))) (and (cons? (tl V5883)) (= blank2 (hd (tl V5883))))))))) (cons (named-pat (intern (hd (tl (hd V5883)))) (blank-seq-pat)) (tl (tl V5883)))) ((and (cons? V5883) (and (cons? (hd V5883)) (and (= id (hd (hd V5883))) (and (cons? (tl (hd V5883))) (and (= () (tl (tl (hd V5883)))) (and (cons? (tl V5883)) (= blank3 (hd (tl V5883))))))))) (cons (named-pat (intern (hd (tl (hd V5883)))) (blank-null-pat)) (tl (tl V5883)))) ((and (cons? V5883) (and (cons? (hd V5883)) (and (= num (hd (hd V5883))) (and (cons? (tl (hd V5883))) (= () (tl (tl (hd V5883)))))))) (cons (int* (hd (tl (hd V5883)))) (tl V5883))) ((and (cons? V5883) (and (cons? (hd V5883)) (and (= id (hd (hd V5883))) (and (cons? (tl (hd V5883))) (and (= () (tl (tl (hd V5883)))) (and (cons? (tl V5883)) (= lbrack (hd (tl V5883))))))))) (let W5884 (p-pat-arglist (tl (tl V5883))) (let W5885 (hd W5884) (let W5886 (tl W5884) (let W5887 (sym* (hd (tl (hd V5883)))) (if (and (cons? W5886) (= (hd W5886) rbrack)) (cons (cons W5887 W5885) (tl W5886)) (simple-error "missing ] in pat app"))))))) ((and (cons? V5883) (and (cons? (hd V5883)) (and (= id (hd (hd V5883))) (and (cons? (tl (hd V5883))) (= () (tl (tl (hd V5883)))))))) (cons (sym* (hd (tl (hd V5883)))) (tl V5883))) ((and (cons? V5883) (= lparen (hd V5883))) (p-pat (tl V5883))) (true (simple-error (cn "p-pat bad " (shen.app V5883 "" shen.a)))))) + +(defun p-pat-arglist (V5888) (cond ((and (cons? V5888) (= rbrack (hd V5888))) (cons () V5888)) (true (let W5889 (p-pat V5888) (let W5890 (hd W5889) (let W5891 (tl W5889) (let W5892 (p-pat-arglist-tail W5891) (let W5893 (hd W5892) (let W5894 (tl W5892) (cons (cons W5890 W5893) W5894)))))))))) + +(defun p-pat-arglist-tail (V5895) (cond ((and (cons? V5895) (= comma (hd V5895))) (let W5896 (p-pat (tl V5895)) (let W5897 (hd W5896) (let W5898 (tl W5896) (let W5899 (p-pat-arglist-tail W5898) (let W5900 (hd W5899) (let W5901 (tl W5899) (cons (cons W5897 W5900) W5901)))))))) (true (cons () V5895)))) + +(defun parse-rule-string (V5902) (let W5903 (tokenize V5902) (let W5904 (p-pat W5903) (let W5905 (hd W5904) (let W5906 (tl W5904) (if (and (cons? W5906) (= (hd W5906) colon-eq)) (let W5907 (tl W5906) (let W5908 (p-expr W5907 0) (let W5909 (hd W5908) (let W5910 (tl W5908) (if (empty? W5910) (make-rule W5905 W5909) (simple-error "rule trailing tokens")))))) (simple-error "rule missing :="))))))) + +(defun parse-and-register-rule (V5911) (let W5912 (parse-rule-string V5911) (register-rule W5912))) + +(defun roundtrip-expr? (V5913) (let W5914 (parse-expr-string V5913) (do (pr (cn "roundtrip-parse " (shen.app V5913 (cn " -> " (shen.app (pretty-expr W5914) " +" shen.a)) shen.a)) (stoutput)) true))) + +(pr "read.shen loaded (SCUD 14.1 recursive descent reader to checked forms). +" (stoutput)) + +(defun expr-prec (V5923) (cond ((and (cons? V5923) (and (= sym (hd V5923)) (and (cons? (tl V5923)) (= () (tl (tl V5923)))))) 100) ((and (cons? V5923) (and (= int (hd V5923)) (and (cons? (tl V5923)) (= () (tl (tl V5923)))))) 100) ((and (cons? V5923) (and (= rat (hd V5923)) (and (cons? (tl V5923)) (and (cons? (tl (tl V5923))) (= () (tl (tl (tl V5923)))))))) 100) (true (if (op-headed? "Equal" V5923) 0 (if (op-headed? "Plus" V5923) 1 (if (op-headed? "Times" V5923) 2 (if (op-headed? "Divide" V5923) 2 (if (op-headed? "Power" V5923) 3 100)))))))) + +(defun op-headed? (V5928 V5929) (cond ((cons? V5929) (and (sym? (hd V5929)) (and (= (sym-name (hd V5929)) (intern V5928)) (>= (length (tl V5929)) 2)))) (true false))) + +(defun paren-if (V5930 V5931 V5932) (if (< V5931 V5930) (@s "(" (@s V5932 ")")) V5932)) + +(defun print-expr (V5933) (cond ((and (cons? V5933) (and (= int (hd V5933)) (and (cons? (tl V5933)) (= () (tl (tl V5933)))))) (str (hd (tl V5933)))) ((and (cons? V5933) (and (= rat (hd V5933)) (and (cons? (tl V5933)) (and (cons? (tl (tl V5933))) (= () (tl (tl (tl V5933)))))))) (@s (str (hd (tl V5933))) (@s "/" (str (hd (tl (tl V5933))))))) ((and (cons? V5933) (and (= sym (hd V5933)) (and (cons? (tl V5933)) (= () (tl (tl V5933)))))) (str (hd (tl V5933)))) ((or (named? V5933) (or (blank? V5933) (or (blank-seq? V5933) (blank-null-seq? V5933)))) (print-pattern V5933)) ((op-headed? "Equal" V5933) (print-equal V5933)) ((op-headed? "Plus" V5933) (print-plus V5933)) ((op-headed? "Times" V5933) (print-times V5933)) ((op-headed? "Divide" V5933) (print-divide V5933)) ((op-headed? "Power" V5933) (print-power V5933)) ((cons? V5933) (@s (print-expr (hd V5933)) (@s "[" (@s (print-args (tl V5933)) "]")))) (true (simple-error (cn "print-expr: unsupported " (shen.app V5933 "" shen.a)))))) + +(defun print-infix (V5936 V5937 V5938 V5939 V5940) (cond ((cons? V5940) (join-infix V5936 V5937 V5938 V5939 (tl V5940))) (true (simple-error "partial function print-infix")))) + +(defun join-infix (V5945 V5946 V5947 V5948 V5949) (cond ((and (cons? V5949) (= () (tl V5949))) (paren-if V5947 (expr-prec (hd V5949)) (print-expr (hd V5949)))) ((cons? V5949) (@s (paren-if V5947 (expr-prec (hd V5949)) (print-expr (hd V5949))) (@s V5945 (join-infix V5945 V5946 V5948 V5948 (tl V5949))))) (true (simple-error "partial function join-infix")))) + +(defun numeric-neg? (V5954) (cond ((and (cons? V5954) (and (= int (hd V5954)) (and (cons? (tl V5954)) (= () (tl (tl V5954)))))) (< (hd (tl V5954)) 0)) ((and (cons? V5954) (and (= rat (hd V5954)) (and (cons? (tl V5954)) (and (cons? (tl (tl V5954))) (= () (tl (tl (tl V5954)))))))) (< (hd (tl V5954)) 0)) (true false))) + +(defun times-coeff (V5957) (cond ((cons? V5957) (find-coeff (tl V5957))) (true (simple-error "partial function times-coeff")))) + +(defun find-coeff (V5958) (cond ((= () V5958) (cons int (cons 1 ()))) ((cons? V5958) (if (numeric? (hd V5958)) (hd V5958) (find-coeff (tl V5958)))) (true (simple-error "partial function find-coeff")))) + +(defun times-others (V5961) (cond ((cons? V5961) (drop-first-numeric (tl V5961))) (true (simple-error "partial function times-others")))) + +(defun drop-first-numeric (V5962) (cond ((= () V5962) ()) ((cons? V5962) (if (numeric? (hd V5962)) (tl V5962) (cons (hd V5962) (drop-first-numeric (tl V5962))))) (true (simple-error "partial function drop-first-numeric")))) + +(defun negate-num (V5963) (cond ((and (cons? V5963) (and (= int (hd V5963)) (and (cons? (tl V5963)) (= () (tl (tl V5963)))))) (cons int (cons (* -1 (hd (tl V5963))) ()))) ((and (cons? V5963) (and (= rat (hd V5963)) (and (cons? (tl V5963)) (and (cons? (tl (tl V5963))) (= () (tl (tl (tl V5963)))))))) (cons rat (cons (* -1 (hd (tl V5963))) (tl (tl V5963))))) (true (simple-error "partial function negate-num")))) + +(defun neg-coeff? (V5966) (cond ((and (cons? V5966) (and (= int (hd V5966)) (and (cons? (tl V5966)) (= () (tl (tl V5966)))))) (< (hd (tl V5966)) 0)) ((and (cons? V5966) (and (= rat (hd V5966)) (and (cons? (tl V5966)) (and (cons? (tl (tl V5966))) (= () (tl (tl (tl V5966)))))))) (< (hd (tl V5966)) 0)) (true (if (op-headed? "Times" V5966) (numeric-neg? (times-coeff V5966)) false)))) + +(defun pos-of (V5967) (cond ((and (cons? V5967) (and (= int (hd V5967)) (and (cons? (tl V5967)) (= () (tl (tl V5967)))))) (cons int (cons (* -1 (hd (tl V5967))) ()))) ((and (cons? V5967) (and (= rat (hd V5967)) (and (cons? (tl V5967)) (and (cons? (tl (tl V5967))) (= () (tl (tl (tl V5967)))))))) (cons rat (cons (* -1 (hd (tl V5967))) (tl (tl V5967))))) (true (rebuild-times (negate-num (times-coeff V5967)) (times-others V5967))))) + +(defun rebuild-times (V5968 V5969) (cond ((and (cons? V5968) (and (= int (hd V5968)) (and (cons? (tl V5968)) (and (= 1 (hd (tl V5968))) (and (= () (tl (tl V5968))) (and (cons? V5969) (= () (tl V5969)))))))) (hd V5969)) ((and (cons? V5968) (and (= int (hd V5968)) (and (cons? (tl V5968)) (and (= 1 (hd (tl V5968))) (= () (tl (tl V5968))))))) (cons (times-head-sym) V5969)) (true (cons (times-head-sym) (cons V5968 V5969))))) + +(defun times-head-sym () (cons sym (cons (intern "Times") ()))) + +(defun print-equal (V5972) (cond ((and (cons? V5972) (and (cons? (tl V5972)) (and (cons? (tl (tl V5972))) (= () (tl (tl (tl V5972))))))) (@s (paren-if 1 (expr-prec (hd (tl V5972))) (print-expr (hd (tl V5972)))) (@s "=" (@s "=" (paren-if 1 (expr-prec (hd (tl (tl V5972)))) (print-expr (hd (tl (tl V5972))))))))) (true (simple-error "partial function print-equal")))) + +(defun print-plus (V5975) (cond ((cons? V5975) (pp-terms (tl V5975) true)) (true (simple-error "partial function print-plus")))) + +(defun pp-terms (V5978 V5979) (cond ((= () V5978) "") ((cons? V5978) (let W5980 (neg-coeff? (hd V5978)) (let W5981 (if W5980 (print-addend (pos-of (hd V5978))) (print-addend (hd V5978))) (let W5982 (if V5979 (if W5980 "-" "") (if W5980 "-" "+")) (@s W5982 (@s W5981 (pp-terms (tl V5978) false))))))) (true (simple-error "partial function pp-terms")))) + +(defun print-addend (V5983) (paren-if 2 (expr-prec V5983) (print-expr V5983))) + +(defun print-times (V5984) (let W5985 (times-coeff V5984) (let W5986 (times-others V5984) (if (numeric-neg? W5985) (@s "-" (print-times-body (negate-num W5985) W5986)) (print-times-body W5985 W5986))))) + +(defun print-times-body (V5987 V5988) (cond ((and (cons? V5987) (and (= int (hd V5987)) (and (cons? (tl V5987)) (and (= 1 (hd (tl V5987))) (= () (tl (tl V5987))))))) (print-product V5988)) (true (@s (print-expr V5987) (@s "*" (print-product V5988)))))) + +(defun print-product (V5989) (cond ((= () V5989) "") ((and (cons? V5989) (= () (tl V5989))) (paren-if 3 (expr-prec (hd V5989)) (print-expr (hd V5989)))) ((cons? V5989) (@s (paren-if 3 (expr-prec (hd V5989)) (print-expr (hd V5989))) (@s "*" (print-product (tl V5989))))) (true (simple-error "partial function print-product")))) + +(defun print-divide (V5992) (cond ((and (cons? V5992) (and (cons? (tl V5992)) (and (cons? (tl (tl V5992))) (= () (tl (tl (tl V5992))))))) (@s (paren-if 2 (expr-prec (hd (tl V5992))) (print-expr (hd (tl V5992)))) (@s "/" (paren-if 3 (expr-prec (hd (tl (tl V5992)))) (print-expr (hd (tl (tl V5992)))))))) (true (simple-error "partial function print-divide")))) + +(defun print-power (V5995) (cond ((and (cons? V5995) (and (cons? (tl V5995)) (and (cons? (tl (tl V5995))) (= () (tl (tl (tl V5995))))))) (@s (paren-if 4 (expr-prec (hd (tl V5995))) (print-expr (hd (tl V5995)))) (@s "^" (print-power-exponent (hd (tl (tl V5995))))))) (true (simple-error "partial function print-power")))) + +(defun print-power-exponent (V5996) (cond ((and (cons? V5996) (and (= rat (hd V5996)) (and (cons? (tl V5996)) (and (cons? (tl (tl V5996))) (= () (tl (tl (tl V5996)))))))) (@s "(" (@s (print-expr V5996) ")"))) (true (paren-if 3 (expr-prec V5996) (print-expr V5996))))) + +(defun print-args (V5997) (cond ((= () V5997) "") ((and (cons? V5997) (= () (tl V5997))) (print-expr (hd V5997))) ((cons? V5997) (@s (print-expr (hd V5997)) (@s "," (print-args (tl V5997))))) (true (simple-error "partial function print-args")))) + +(defun print-pattern (V5998) (if (named? V5998) (print-named (named-name V5998) (named-subpattern V5998)) (if (blank? V5998) "_" (if (blank-seq? V5998) "__" (if (blank-null-seq? V5998) "___" (simple-error (cn "print-pattern: " (shen.app V5998 "" shen.a)))))))) + +(defun print-named (V5999 V6000) (@s (str V5999) (blank-suffix V6000))) + +(defun blank-suffix (V6001) (if (blank? V6001) "_" (if (blank-seq? V6001) "__" (if (blank-null-seq? V6001) "___" (simple-error (cn "blank-suffix: " (shen.app V6001 "" shen.a))))))) + +(pr "print.shen loaded (round-trippable printer). +" (stoutput)) + diff --git a/crates/shenffi/cas/cas-kernel.kl b/crates/shenffi/cas/cas-kernel.kl new file mode 100644 index 0000000..9638e6e --- /dev/null +++ b/crates/shenffi/cas/cas-kernel.kl @@ -0,0 +1,1272 @@ +(defun shen.shen->kl (V531) (let W532 (shen.shen->kl-h V531) (shen.record-and-evaluate W532))) + +(defun shen.record-and-evaluate (V533) (cond ((and (cons? V533) (and (= defun (hd V533)) (and (cons? (tl V533)) (and (cons? (tl (tl V533))) (and (cons? (tl (tl (tl V533)))) (= () (tl (tl (tl (tl V533)))))))))) (let W534 (if (shen.sysfunc? (hd (tl V533))) (simple-error (shen.app (hd (tl V533)) " is not a legitimate function name +" shen.a)) shen.skip) (let W535 (shen.store-arity (hd (tl V533)) (length (hd (tl (tl V533))))) (let W536 (shen.record-kl (hd (tl V533)) V533) (let W537 (eval-kl V533) (shen.fn-print (hd (tl V533)))))))) (true V533))) + +(defun shen.shen->kl-h (V538) (cond ((and (cons? V538) (and (= define (hd V538)) (cons? (tl V538)))) (shen.shendef->kldef (hd (tl V538)) (tl (tl V538)))) ((and (cons? V538) (and (= defun (hd V538)) (and (cons? (tl V538)) (and (cons? (tl (tl V538))) (and (cons? (tl (tl (tl V538)))) (= () (tl (tl (tl (tl V538)))))))))) V538) ((and (cons? V538) (and (= type (hd V538)) (and (cons? (tl V538)) (and (cons? (tl (tl V538))) (= () (tl (tl (tl V538)))))))) (cons type (cons (hd (tl V538)) (cons (shen.rcons_form (hd (tl (tl V538)))) ())))) ((and (cons? V538) (and (= input+ (hd V538)) (and (cons? (tl V538)) (and (cons? (tl (tl V538))) (= () (tl (tl (tl V538)))))))) (cons input+ (cons (shen.rcons_form (hd (tl V538))) (tl (tl V538))))) ((cons? V538) (map (lambda Z539 (shen.shen->kl-h Z539)) V538)) (true V538))) + +(defun shen.shendef->kldef (V540 V541) (compile (lambda Z542 (shen. Z542)) (cons V540 V541))) + +(defun shen. (V543) (let W544 (let W545 (shen. V543) (if (shen.parse-failure? W545) (shen.parse-failure) (let W546 (shen.<-out W545) (let W547 (shen.in-> W545) (if (shen.hds=? W547 {) (let W548 (tail W547) (let W549 (shen. W548) (if (shen.parse-failure? W549) (shen.parse-failure) (let W550 (shen.in-> W549) (if (shen.hds=? W550 }) (let W551 (tail W550) (let W552 (shen. W551) (if (shen.parse-failure? W552) (shen.parse-failure) (let W553 (shen.<-out W552) (let W554 (shen.in-> W552) (shen.comb W554 (shen.shendef->kldef-h W546 W553))))))) (shen.parse-failure)))))) (shen.parse-failure)))))) (if (shen.parse-failure? W544) (let W555 (let W556 (shen. V543) (if (shen.parse-failure? W556) (shen.parse-failure) (let W557 (shen.<-out W556) (let W558 (shen.in-> W556) (let W559 (shen. W558) (if (shen.parse-failure? W559) (shen.parse-failure) (let W560 (shen.<-out W559) (let W561 (shen.in-> W559) (shen.comb W561 (shen.shendef->kldef-h W557 W560)))))))))) (if (shen.parse-failure? W555) (shen.parse-failure) W555)) W544))) + +(defun shen.shendef->kldef-h (V562 V563) (let W564 (map (lambda Z565 (fst Z565)) V563) (let W566 (shen.arity-chk V562 W564) (let W567 (map (lambda Z568 (shen.free-var-chk V562 Z568)) V563) (let W569 (shen.unprotect V563) (let W570 (shen.factorise-code (shen.compile-to-kl V562 W569 W566)) W570)))))) + +(defun shen.unprotect (V571) (cond ((tuple? V571) (@p (shen.unprotect (fst V571)) (shen.unprotect (snd V571)))) ((and (cons? V571) (and (= protect (hd V571)) (and (cons? (tl V571)) (= () (tl (tl V571)))))) (shen.unprotect (hd (tl V571)))) ((cons? V571) (map (lambda Z572 (shen.unprotect Z572)) V571)) (true V571))) + +(defun shen. (V573) (let W574 (if (cons? V573) (let W575 (head V573) (let W576 (tail V573) (shen.comb W576 (if (and (symbol? W575) (not (variable? W575))) W575 (simple-error (shen.app W575 " is not a legitimate function name. +" shen.a)))))) (shen.parse-failure)) (if (shen.parse-failure? W574) (shen.parse-failure) W574))) + +(defun shen. (V577) (let W578 (if (cons? V577) (let W579 (head V577) (let W580 (tail V577) (let W581 (shen. W580) (if (shen.parse-failure? W581) (shen.parse-failure) (let W582 (shen.<-out W581) (let W583 (shen.in-> W581) (if (not (element? W579 (cons { (cons } ())))) (shen.comb W583 (cons W579 W582)) (shen.parse-failure)))))))) (shen.parse-failure)) (if (shen.parse-failure? W578) (let W584 (let W585 ( V577) (if (shen.parse-failure? W585) (shen.parse-failure) (let W586 (shen.in-> W585) (shen.comb W586 ())))) (if (shen.parse-failure? W584) (shen.parse-failure) W584)) W578))) + +(defun shen. (V587) (let W588 (let W589 (shen. V587) (if (shen.parse-failure? W589) (shen.parse-failure) (let W590 (shen.<-out W589) (let W591 (shen.in-> W589) (let W592 (shen. W591) (if (shen.parse-failure? W592) (shen.parse-failure) (let W593 (shen.<-out W592) (let W594 (shen.in-> W592) (shen.comb W594 (cons (shen.linearise W590) W593)))))))))) (if (shen.parse-failure? W588) (let W595 (let W596 ( V587) (if (shen.parse-failure? W596) (shen.parse-failure) (let W597 (shen.<-out W596) (let W598 (shen.in-> W596) (shen.comb W598 (if (empty? W597) () (simple-error (cn "Shen syntax error here: + " (shen.app W597 " + ..." shen.r))))))))) (if (shen.parse-failure? W595) (shen.parse-failure) W595)) W588))) + +(defun shen.linearise (V601) (cond ((tuple? V601) (shen.linearise-h (fst V601) (fst V601) () (snd V601))) (true (simple-error "implementation error in shen.linearise")))) + +(defun shen.linearise-h (V614 V615 V616 V617) (cond ((= () V614) (@p V615 V617)) ((and (cons? V614) (cons? (hd V614))) (shen.linearise-h (append (hd V614) (tl V614)) V615 V616 V617)) ((and (cons? V614) (variable? (hd V614))) (if (element? (hd V614) V616) (let W618 (gensym V) (shen.linearise-h (tl V614) (shen.rep-X (hd V614) W618 V615) V616 (cons where (cons (cons = (cons W618 (cons (hd V614) ()))) (cons V617 ()))))) (shen.linearise-h (tl V614) V615 (cons (hd V614) V616) V617))) ((cons? V614) (shen.linearise-h (tl V614) V615 V616 V617)) (true (simple-error "implementation error in shen.linearise-h")))) + +(defun shen. (V619) (let W620 (let W621 (shen. V619) (if (shen.parse-failure? W621) (shen.parse-failure) (let W622 (shen.<-out W621) (let W623 (shen.in-> W621) (if (shen.hds=? W623 ->) (let W624 (tail W623) (if (cons? W624) (let W625 (head W624) (let W626 (tail W624) (if (shen.hds=? W626 where) (let W627 (tail W626) (if (cons? W627) (let W628 (head W627) (let W629 (tail W627) (shen.comb W629 (@p W622 (cons where (cons W628 (cons W625 ()))))))) (shen.parse-failure))) (shen.parse-failure)))) (shen.parse-failure))) (shen.parse-failure)))))) (if (shen.parse-failure? W620) (let W630 (let W631 (shen. V619) (if (shen.parse-failure? W631) (shen.parse-failure) (let W632 (shen.<-out W631) (let W633 (shen.in-> W631) (if (shen.hds=? W633 ->) (let W634 (tail W633) (if (cons? W634) (let W635 (head W634) (let W636 (tail W634) (shen.comb W636 (@p W632 W635)))) (shen.parse-failure))) (shen.parse-failure)))))) (if (shen.parse-failure? W630) (let W637 (let W638 (shen. V619) (if (shen.parse-failure? W638) (shen.parse-failure) (let W639 (shen.<-out W638) (let W640 (shen.in-> W638) (if (shen.hds=? W640 <-) (let W641 (tail W640) (if (cons? W641) (let W642 (head W641) (let W643 (tail W641) (if (shen.hds=? W643 where) (let W644 (tail W643) (if (cons? W644) (let W645 (head W644) (let W646 (tail W644) (shen.comb W646 (@p W639 (cons where (cons W645 (cons (cons shen.choicepoint! (cons W642 ())) ()))))))) (shen.parse-failure))) (shen.parse-failure)))) (shen.parse-failure))) (shen.parse-failure)))))) (if (shen.parse-failure? W637) (let W647 (let W648 (shen. V619) (if (shen.parse-failure? W648) (shen.parse-failure) (let W649 (shen.<-out W648) (let W650 (shen.in-> W648) (if (shen.hds=? W650 <-) (let W651 (tail W650) (if (cons? W651) (let W652 (head W651) (let W653 (tail W651) (shen.comb W653 (@p W649 (cons shen.choicepoint! (cons W652 ())))))) (shen.parse-failure))) (shen.parse-failure)))))) (if (shen.parse-failure? W647) (shen.parse-failure) W647)) W637)) W630)) W620))) + +(defun shen. (V654) (let W655 (let W656 (shen. V654) (if (shen.parse-failure? W656) (shen.parse-failure) (let W657 (shen.<-out W656) (let W658 (shen.in-> W656) (let W659 (shen. W658) (if (shen.parse-failure? W659) (shen.parse-failure) (let W660 (shen.<-out W659) (let W661 (shen.in-> W659) (shen.comb W661 (cons W657 W660)))))))))) (if (shen.parse-failure? W655) (let W662 (let W663 ( V654) (if (shen.parse-failure? W663) (shen.parse-failure) (let W664 (shen.in-> W663) (shen.comb W664 ())))) (if (shen.parse-failure? W662) (shen.parse-failure) W662)) W655))) + +(defun shen. (V665) (let W666 (if (shen.ccons? V665) (let W667 (head V665) (let W668 (tail V665) (if (shen.hds=? W667 vector) (let W669 (tail W667) (if (shen.hds=? W669 0) (let W670 (tail W669) (let W671 ( W670) (if (shen.parse-failure? W671) (shen.parse-failure) (let W672 (shen.in-> W671) (shen.comb W668 (cons vector (cons 0 ()))))))) (shen.parse-failure))) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W666) (let W673 (if (cons? V665) (let W674 (head V665) (let W675 (tail V665) (if (cons? W674) (shen.comb W675 (shen.compound-pattern W674)) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W673) (let W676 (let W677 (shen. V665) (if (shen.parse-failure? W677) (shen.parse-failure) (let W678 (shen.<-out W677) (let W679 (shen.in-> W677) (shen.comb W679 W678))))) (if (shen.parse-failure? W676) (shen.parse-failure) W676)) W673)) W666))) + +(defun shen.constructor? (V684) (element? V684 (cons cons (cons @p (cons @s (cons @v ())))))) + +(defun shen.constructor-error (V685) (simple-error (shen.app V685 " is not a legitimate constructor +" shen.r))) + +(defun shen.custom-pattern-compiler (V686 V687) (let W688 (value shen.*custom-pattern-compiler*) (if (= W688 false) (thaw V687) ((W688 V686) V687)))) + +(defun shen.custom-pattern-reducer (V689) (let W690 (value shen.*custom-pattern-reducer*) (if (= W690 false) (fail) (W690 V689)))) + +(defun shen.compound-pattern (V691) (shen.custom-pattern-compiler V691 (freeze (shen.compound-pattern-h V691)))) + +(defun shen.compound-pattern-h (V692) (cond ((and (cons? V692) (and (cons? (tl V692)) (and (cons? (tl (tl V692))) (and (= () (tl (tl (tl V692)))) (shen.constructor? (hd V692)))))) (cons (hd V692) (cons (shen.compile-pattern-fragment (hd (tl V692))) (cons (shen.compile-pattern-fragment (hd (tl (tl V692)))) ())))) (true (shen.constructor-error V692)))) + +(defun shen.compile-pattern-fragment (V693) (cond ((and (cons? V693) (and (= vector (hd V693)) (and (cons? (tl V693)) (and (= 0 (hd (tl V693))) (= () (tl (tl V693))))))) V693) ((cons? V693) (shen.compound-pattern V693)) ((= V693 _) (gensym Y)) ((not (element? V693 (cons -> (cons <- ())))) V693) (true (shen.constructor-error V693)))) + +(defun shen.custom-pattern? (V698) (cond ((and (cons? V698) (and (= @p (hd V698)) (and (cons? (tl V698)) (and (= shen.custom-pattern (hd (tl V698))) (and (cons? (tl (tl V698))) (= () (tl (tl (tl V698))))))))) true) (true false))) + +(defun shen.custom-pattern-body (V701) (cond ((and (cons? V701) (and (= @p (hd V701)) (and (cons? (tl V701)) (and (= shen.custom-pattern (hd (tl V701))) (and (cons? (tl (tl V701))) (= () (tl (tl (tl V701))))))))) (hd (tl (tl V701)))) (true (simple-error "implementation error in shen.custom-pattern-body")))) + +(defun shen. (V702) (let W703 (if (cons? V702) (let W704 (head V702) (let W705 (tail V702) (if (= W704 _) (shen.comb W705 (gensym Y)) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W703) (let W706 (if (cons? V702) (let W707 (head V702) (let W708 (tail V702) (if (not (element? W707 (cons -> (cons <- ())))) (shen.comb W708 W707) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W706) (shen.parse-failure) W706)) W703))) + +(defun shen.fn-print (V719) (let W720 (absvector 2) (let W721 (address-> W720 0 shen.printF) (let W722 (address-> W721 1 (@s "(" (@s "f" (@s "n" (@s " " (@s (str V719) ")")))))) W722)))) + +(defun shen.printF (V723) (<-address V723 1)) + +(defun shen.arity-chk (V728 V729) (cond ((and (cons? V729) (= () (tl V729))) (length (hd V729))) ((and (cons? V729) (and (cons? (tl V729)) (= (length (hd V729)) (length (hd (tl V729)))))) (shen.arity-chk V728 (tl V729))) (true (simple-error (cn "arity error in " (shen.app V728 " +" shen.a)))))) + +(defun shen.free-var-chk (V730 V731) (cond ((tuple? V731) (shen.free-variable-error-message V730 (shen.find-free-vars (shen.extract-vars (fst V731)) (snd V731)))) (true (shen.f-error shen.free-var-chk)))) + +(defun shen.free-variable-error-message (V732 V733) (if (empty? V733) shen.skip (do (pr (cn "free variables in " (shen.app V732 ":" shen.a)) (stoutput)) (do (shen.for-each (lambda Z734 (pr (cn " " (shen.app Z734 "" shen.a)) (stoutput))) V733) (do (nl 1) (abort)))))) + +(defun shen.extract-vars (V737) (cond ((variable? V737) (cons V737 ())) ((cons? V737) (union (shen.extract-vars (hd V737)) (shen.extract-vars (tl V737)))) (true ()))) + +(defun shen.find-free-vars (V742 V743) (cond ((and (cons? V743) (and (= protect (hd V743)) (and (cons? (tl V743)) (= () (tl (tl V743)))))) ()) ((and (cons? V743) (and (= let (hd V743)) (and (cons? (tl V743)) (and (cons? (tl (tl V743))) (and (cons? (tl (tl (tl V743)))) (= () (tl (tl (tl (tl V743)))))))))) (union (shen.find-free-vars V742 (hd (tl (tl V743)))) (shen.find-free-vars (cons (hd (tl V743)) V742) (hd (tl (tl (tl V743))))))) ((and (cons? V743) (and (= lambda (hd V743)) (and (cons? (tl V743)) (and (cons? (tl (tl V743))) (= () (tl (tl (tl V743)))))))) (shen.find-free-vars (cons (hd (tl V743)) V742) (hd (tl (tl V743))))) ((cons? V743) (union (shen.find-free-vars V742 (hd V743)) (shen.find-free-vars V742 (tl V743)))) ((shen.free-variable? V743 V742) (cons V743 ())) (true ()))) + +(defun shen.free-variable? (V744 V745) (and (variable? V744) (not (element? V744 V745)))) + +(defun shen.record-kl (V746 V747) (do (set shen.*userdefs* (adjoin V746 (value shen.*userdefs*))) (put V746 shen.source V747 (value *property-vector*)))) + +(defun shen.compile-to-kl (V748 V749 V750) (let W751 (shen.parameters V750) (let W752 (shen.scan-body V748 (shen.kl-body V749 W751)) (let W753 (cons defun (cons V748 (cons W751 (cons (shen.cond-form W752) ())))) W753)))) + +(defun shen.parameters (V754) (cond ((= 0 V754) ()) (true (cons (gensym V) (shen.parameters (- V754 1)))))) + +(defun shen.cond-form (V757) (cond ((and (cons? V757) (and (cons? (hd V757)) (and (= true (hd (hd V757))) (and (cons? (tl (hd V757))) (= () (tl (tl (hd V757)))))))) (hd (tl (hd V757)))) (true (cons cond V757)))) + +(defun shen.scan-body (V766 V767) (cond ((= () V767) (cons (cons true (cons (cons shen.f-error (cons V766 ())) ())) ())) ((and (cons? V767) (shen.choicepoint? (hd V767))) (shen.choicepoint V766 (gensym Freeze) (gensym Result) (hd V767) (tl V767))) ((and (cons? V767) (and (cons? (hd V767)) (and (= true (hd (hd V767))) (and (cons? (tl (hd V767))) (= () (tl (tl (hd V767)))))))) (cons (hd V767) ())) ((cons? V767) (cons (hd V767) (shen.scan-body V766 (tl V767)))) (true (simple-error "implementation error in shen.scan-body")))) + +(defun shen.choicepoint? (V774) (cond ((and (cons? V774) (and (cons? (tl V774)) (and (cons? (hd (tl V774))) (and (= shen.choicepoint! (hd (hd (tl V774)))) (and (cons? (tl (hd (tl V774)))) (and (= () (tl (tl (hd (tl V774))))) (= () (tl (tl V774))))))))) true) (true false))) + +(defun shen.choicepoint (V790 V791 V792 V793 V794) (cond ((and (cons? V793) (and (cons? (tl V793)) (and (cons? (hd (tl V793))) (and (cons? (tl (hd (tl V793)))) (and (cons? (hd (tl (hd (tl V793))))) (and (= fail-if (hd (hd (tl (hd (tl V793)))))) (and (cons? (tl (hd (tl (hd (tl V793)))))) (and (cons? (tl (tl (hd (tl (hd (tl V793))))))) (and (= () (tl (tl (tl (hd (tl (hd (tl V793)))))))) (and (= () (tl (tl (hd (tl V793))))) (and (= () (tl (tl V793))) (= V790 (hd (tl (hd (tl (hd (tl V793)))))))))))))))))) (cons (cons true (cons (cons let (cons V791 (cons (cons freeze (cons (cons cond (shen.scan-body (hd (tl (hd (tl (hd (tl V793)))))) V794)) ())) (cons (cons if (cons (hd V793) (cons (cons let (cons V792 (cons (hd (tl (tl (hd (tl (hd (tl V793))))))) (cons (cons if (cons (cons (hd (tl (hd (tl (hd (tl V793)))))) (cons V792 ())) (cons (cons thaw (cons V791 ())) (cons V792 ())))) ())))) (cons (cons thaw (cons V791 ())) ())))) ())))) ())) ())) ((and (cons? V793) (and (cons? (tl V793)) (and (cons? (hd (tl V793))) (and (cons? (tl (hd (tl V793)))) (and (= () (tl (tl (hd (tl V793))))) (= () (tl (tl V793)))))))) (cons (cons true (cons (cons let (cons V791 (cons (cons freeze (cons (cons cond (shen.scan-body V790 V794)) ())) (cons (cons if (cons (hd V793) (cons (cons let (cons V792 (cons (hd (tl (hd (tl V793)))) (cons (cons if (cons (cons = (cons V792 (cons (cons fail ()) ()))) (cons (cons thaw (cons V791 ())) (cons V792 ())))) ())))) (cons (cons thaw (cons V791 ())) ())))) ())))) ())) ())) (true (simple-error "implementation error in shen.choicepoint")))) + +(defun shen.rep-X (V796 V797 V798) (cond ((= V796 V798) V797) ((cons? V798) (let W799 (shen.rep-X V796 V797 (hd V798)) (if (= W799 (hd V798)) (cons (hd V798) (shen.rep-X V796 V797 (tl V798))) (cons W799 (tl V798))))) (true V798))) + +(defun shen.alpha-convert (V800) (cond ((and (cons? V800) (and (= lambda (hd V800)) (and (cons? (tl V800)) (and (cons? (tl (tl V800))) (= () (tl (tl (tl V800)))))))) (let W801 (gensym Z) (let W802 (cons lambda (cons W801 (cons (shen.beta (hd (tl V800)) W801 (hd (tl (tl V800)))) ()))) (map (lambda Z803 (shen.alpha-convert Z803)) W802)))) ((and (cons? V800) (and (= let (hd V800)) (and (cons? (tl V800)) (and (cons? (tl (tl V800))) (and (cons? (tl (tl (tl V800)))) (= () (tl (tl (tl (tl V800)))))))))) (let W804 (gensym W) (let W805 (cons let (cons W804 (cons (hd (tl (tl V800))) (cons (shen.beta (hd (tl V800)) W804 (hd (tl (tl (tl V800))))) ())))) (map (lambda Z806 (shen.alpha-convert Z806)) W805)))) ((cons? V800) (map (lambda Z807 (shen.alpha-convert Z807)) V800)) (true V800))) + +(defun shen.kl-body (V808 V809) (map (lambda Z810 (shen.triple-stack () (fst Z810) V809 (shen.alpha-convert (snd Z810)))) V808)) + +(defun shen.triple-stack (V819 V820 V821 V822) (cond ((and (= () V820) (and (= () V821) (and (cons? V822) (and (= where (hd V822)) (and (cons? (tl V822)) (and (cons? (tl (tl V822))) (= () (tl (tl (tl V822)))))))))) (shen.triple-stack (cons (hd (tl V822)) V819) () () (hd (tl (tl V822))))) ((and (= () V820) (= () V821)) (cons (shen.rectify-test (reverse V819)) (cons V822 ()))) ((and (cons? V820) (and (cons? V821) (variable? (hd V820)))) (shen.triple-stack V819 (tl V820) (tl V821) (shen.beta (hd V820) (hd V821) V822))) ((and (cons? V820) (and (cons? V821) (shen.custom-pattern? (hd V820)))) (shen.custom-pattern-triple-stack V819 (shen.custom-pattern-body (hd V820)) (tl V820) (hd V821) (tl V821) V822)) ((and (cons? V820) (and (cons? (hd V820)) (and (cons? (tl (hd V820))) (and (cons? (tl (tl (hd V820)))) (and (= () (tl (tl (tl (hd V820))))) (and (cons? V821) (shen.constructor? (hd (hd V820))))))))) (shen.triple-stack (cons (cons (shen.op-test (hd (hd V820))) (cons (hd V821) ())) V819) (cons (hd (tl (hd V820))) (cons (hd (tl (tl (hd V820)))) (tl V820))) (cons (cons (shen.op1 (hd (hd V820))) (cons (hd V821) ())) (cons (cons (shen.op2 (hd (hd V820))) (cons (hd V821) ())) (tl V821))) (shen.beta (hd V820) (hd V821) V822))) ((and (cons? V820) (cons? V821)) (shen.triple-stack (cons (cons = (cons (hd V820) (cons (hd V821) ()))) V819) (tl V820) (tl V821) V822)) (true (simple-error "implementation error in shen.triple-stack")))) + +(defun shen.custom-pattern-triple-stack (V823 V824 V825 V826 V827 V828) (let W829 (shen.custom-pattern-reducer (@p V824 V826)) (if (tuple? W829) (let W830 (fst W829) (let W831 (snd W829) (shen.triple-stack (append (reverse W830) V823) (append (map (lambda Z832 (fst Z832)) W831) V825) (append (map (lambda Z833 (snd Z833)) W831) V827) (shen.beta V824 V826 V828)))) (shen.constructor-error V824)))) + +(defun shen.rectify-test (V836) (cond ((= () V836) true) ((and (cons? V836) (= () (tl V836))) (hd V836)) ((and (cons? V836) (cons? (tl V836))) (cons and (cons (hd V836) (cons (shen.rectify-test (tl V836)) ())))) (true (simple-error "implementation error in shen.rectify-test")))) + +(defun shen.beta (V846 V847 V848) (cond ((= V846 V848) V847) ((and (cons? V848) (and (= lambda (hd V848)) (and (cons? (tl V848)) (and (cons? (tl (tl V848))) (and (= () (tl (tl (tl V848)))) (= V846 (hd (tl V848)))))))) V848) ((and (cons? V848) (and (= let (hd V848)) (and (cons? (tl V848)) (and (cons? (tl (tl V848))) (and (cons? (tl (tl (tl V848)))) (and (= () (tl (tl (tl (tl V848))))) (= V846 (hd (tl V848))))))))) (cons let (cons (hd (tl V848)) (cons (shen.beta (hd (tl V848)) V847 (hd (tl (tl V848)))) (tl (tl (tl V848))))))) ((cons? V848) (map (lambda Z849 (shen.beta V846 V847 Z849)) V848)) (true V848))) + +(defun shen.op1 (V852) (cond ((= cons V852) hd) ((= @s V852) hdstr) ((= @p V852) fst) ((= @v V852) hdv) (true (simple-error "implementation error in shen.op1")))) + +(defun shen.op2 (V855) (cond ((= cons V855) tl) ((= @s V855) tlstr) ((= @p V855) snd) ((= @v V855) tlv) (true (simple-error "implementation error in shen.op2")))) + +(defun shen.op-test (V858) (cond ((= cons V858) cons?) ((= @s V858) shen.+string?) ((= @p V858) tuple?) ((= @v V858) shen.+vector?) (true (simple-error "implementation error in shen.op-test")))) + +(defun shen.+string? (V859) (cond ((= "" V859) false) (true (string? V859)))) + +(defun shen.+vector? (V860) (cond ((= V860 (vector 0)) false) (true (vector? V860)))) + +(defun shen.factorise-code (V864) (cond ((value shen.*factorise?*) (shen.factor V864)) (true V864))) + +(defun shen.factor (V865) (cond ((and (cons? V865) (and (= defun (hd V865)) (and (cons? (tl V865)) (and (cons? (tl (tl V865))) (and (cons? (tl (tl (tl V865)))) (and (cons? (hd (tl (tl (tl V865))))) (and (= cond (hd (hd (tl (tl (tl V865)))))) (= () (tl (tl (tl (tl V865)))))))))))) (cons defun (cons (hd (tl V865)) (cons (hd (tl (tl V865))) (cons (shen.factor-recognisors (tl (hd (tl (tl (tl V865)))))) ()))))) (true V865))) + +(defun shen.factor-recognisors (V868) (cond ((and (cons? V868) (and (cons? (hd V868)) (and (= true (hd (hd V868))) (and (cons? (tl (hd V868))) (= () (tl (tl (hd V868)))))))) (hd (tl (hd V868)))) ((and (cons? V868) (and (cons? (hd V868)) (and (cons? (hd (hd V868))) (and (= and (hd (hd (hd V868)))) (and (cons? (tl (hd (hd V868)))) (and (cons? (tl (tl (hd (hd V868))))) (and (= () (tl (tl (tl (hd (hd V868)))))) (and (cons? (tl (hd V868))) (= () (tl (tl (hd V868)))))))))))) (let W869 (shen.pivot-on (hd (tl (hd (hd V868)))) V868 ()) (let W870 (fst W869) (if (shen.bad-pivot? W870) (cons if (cons (hd (hd V868)) (cons (hd (tl (hd V868))) (cons (shen.factor-recognisors (tl V868)) ())))) (let W871 (snd W869) (let W872 (shen.factor-recognisors W871) (let W873 (gensym GoTo) (let W874 (reverse (cons (cons true (cons (cons thaw (cons W873 ())) ())) W870)) (let W875 (cons let (cons W873 (cons (cons freeze (cons W872 ())) (cons (cons if (cons (hd (tl (hd (hd V868)))) (cons (shen.factor-selectors (hd (tl (hd (hd V868)))) (shen.factor-recognisors W874)) (cons (cons thaw (cons W873 ())) ())))) ())))) (shen.remove-indirection W875)))))))))) ((and (cons? V868) (and (cons? (hd V868)) (and (cons? (tl (hd V868))) (= () (tl (tl (hd V868))))))) (cons if (cons (hd (hd V868)) (cons (hd (tl (hd V868))) (cons (shen.factor-recognisors (tl V868)) ()))))) (true (shen.f-error shen.factor-recognisors)))) + +(defun shen.bad-pivot? (V880) (cond ((and (cons? V880) (= () (tl V880))) true) (true false))) + +(defun shen.remove-indirection (V881) (cond ((and (cons? V881) (and (= let (hd V881)) (and (cons? (tl V881)) (and (cons? (tl (tl V881))) (and (cons? (hd (tl (tl V881)))) (and (= freeze (hd (hd (tl (tl V881))))) (and (cons? (tl (hd (tl (tl V881))))) (and (cons? (hd (tl (hd (tl (tl V881)))))) (and (= thaw (hd (hd (tl (hd (tl (tl V881))))))) (and (cons? (tl (hd (tl (hd (tl (tl V881))))))) (and (= () (tl (tl (hd (tl (hd (tl (tl V881)))))))) (and (= () (tl (tl (hd (tl (tl V881)))))) (and (cons? (tl (tl (tl V881)))) (and (= () (tl (tl (tl (tl V881))))) (symbol? (hd (tl (hd (tl (hd (tl (tl V881)))))))))))))))))))))) (subst (hd (tl (hd (tl (hd (tl (tl V881))))))) (hd (tl V881)) (hd (tl (tl (tl V881)))))) (true V881))) + +(defun shen.pivot-on (V884 V885 V886) (cond ((and (cons? V885) (and (cons? (hd V885)) (and (cons? (hd (hd V885))) (and (= and (hd (hd (hd V885)))) (and (cons? (tl (hd (hd V885)))) (and (cons? (tl (tl (hd (hd V885))))) (and (= () (tl (tl (tl (hd (hd V885)))))) (and (cons? (tl (hd V885))) (and (= () (tl (tl (hd V885)))) (= V884 (hd (tl (hd (hd V885)))))))))))))) (shen.pivot-on (hd (tl (hd (hd V885)))) (tl V885) (cons (cons (hd (tl (tl (hd (hd V885))))) (tl (hd V885))) V886))) ((and (cons? V885) (and (cons? (hd V885)) (and (cons? (tl (hd V885))) (and (= () (tl (tl (hd V885)))) (= V884 (hd (hd V885))))))) (shen.pivot-on (hd (hd V885)) (tl V885) (cons (cons true (tl (hd V885))) V886))) (true (@p V886 V885)))) + +(defun shen.factor-selectors (V889 V890) (cond ((and (cons? V889) (and (cons? (tl V889)) (= () (tl (tl V889))))) (let W891 (shen.op (hd V889)) (if (= shen.skip W891) V890 (shen.factor-selectors-h (cons (cons (shen.op1 W891) (tl V889)) (cons (cons (shen.op2 W891) (tl V889)) ())) V890)))) (true V890))) + +(defun shen.op (V894) (cond ((= cons? V894) cons) ((= shen.+string? V894) @s) ((= shen.+vector? V894) @v) ((= tuple? V894) @p) (true shen.skip))) + +(defun shen.factor-selectors-h (V895 V896) (cond ((= () V895) V896) ((cons? V895) (if (> (occurrences (hd V895) V896) 1) (let W897 (gensym Select) (cons let (cons W897 (cons (hd V895) (cons (shen.factor-selectors-h (tl V895) (subst W897 (hd V895) V896)) ()))))) (shen.factor-selectors-h (tl V895) V896))) (true (shen.f-error shen.factor-selectors-h)))) + +(defun thaw (V3767) (V3767)) + +(defun eval (V3768) (eval-kl (shen.shen->kl (shen.process-applications (macroexpand V3768) (shen.find-types V3768))))) + +(defun external (V3769) (cond ((= null V3769) ()) (true (trap-error (get V3769 shen.external-symbols (value *property-vector*)) (lambda Z3770 (simple-error (cn "package " (shen.app V3769 " does not exist. +;" shen.a)))))))) + +(defun fail-if (V3773 V3774) (if (V3773 V3774) (fail) V3774)) + +(defun @s (V3775 V3776) (cn V3775 V3776)) + +(defun ps (V3777) (trap-error (get V3777 shen.source (value *property-vector*)) (lambda Z3778 (simple-error (shen.app V3777 " not found. +" shen.a))))) + +(defun stinput () (value *stinput*)) + +(defun vector (V3779) (let W3780 (absvector (+ V3779 1)) (let W3781 (address-> W3780 0 V3779) (let W3782 (if (= V3779 0) W3781 (shen.fillvector W3781 1 V3779 (fail))) W3782)))) + +(defun shen.fillvector (V3784 V3785 V3786 V3787) (cond ((= V3785 V3786) (address-> V3784 V3786 V3787)) (true (shen.fillvector (address-> V3784 V3785 V3787) (+ 1 V3785) V3786 V3787)))) + +(defun vector? (V3788) (and (absvector? V3788) (let W3789 (trap-error (<-address V3788 0) (lambda Z3790 -1)) (and (number? W3789) (>= W3789 0))))) + +(defun vector-> (V3791 V3792 V3793) (if (= V3792 0) (simple-error "cannot access 0th element of a vector +") (address-> V3791 V3792 V3793))) + +(defun <-vector (V3794 V3795) (if (= V3795 0) (simple-error "cannot access 0th element of a vector +") (let W3796 (<-address V3794 V3795) (if (= W3796 (fail)) (simple-error "vector element not found +") W3796)))) + +(defun limit (V3798) (<-address V3798 0)) + +(defun symbol? (V3799) (cond ((or (boolean? V3799) (or (number? V3799) (or (string? V3799) (or (cons? V3799) (or (empty? V3799) (vector? V3799)))))) false) ((element? V3799 (cons { (cons } (cons (intern ":") (cons (intern ";") (cons (intern ",") ())))))) true) (true (trap-error (let W3800 (str V3799) (shen.analyse-symbol? W3800)) (lambda Z3801 false))))) + +(defun shen.analyse-symbol? (V3804) (cond ((shen.+string? V3804) (and (shen.alpha? (string->n (hdstr V3804))) (shen.alphanums? (tlstr V3804)))) (true (simple-error "implementation error in shen.analyse-symbol?")))) + +(defun shen.alphanums? (V3807) (cond ((= "" V3807) true) ((shen.+string? V3807) (let W3808 (string->n (hdstr V3807)) (and (or (shen.alpha? W3808) (shen.digit? W3808)) (shen.alphanums? (tlstr V3807))))) (true (simple-error "implementation error in shen.alphanums?")))) + +(defun variable? (V3809) (cond ((or (boolean? V3809) (or (number? V3809) (string? V3809))) false) (true (trap-error (let W3810 (str V3809) (shen.analyse-variable? W3810)) (lambda Z3811 false))))) + +(defun shen.analyse-variable? (V3814) (cond ((shen.+string? V3814) (and (shen.uppercase? (string->n (hdstr V3814))) (shen.alphanums? (tlstr V3814)))) (true (simple-error "implementation error in shen.analyse-variable?")))) + +(defun gensym (V3815) (concat V3815 (set shen.*gensym* (+ 1 (value shen.*gensym*))))) + +(defun concat (V3816 V3817) (intern (cn (str V3816) (str V3817)))) + +(defun @p (V3818 V3819) (let W3820 (absvector 3) (let W3821 (address-> W3820 0 shen.tuple) (let W3822 (address-> W3820 1 V3818) (let W3823 (address-> W3820 2 V3819) W3820))))) + +(defun fst (V3824) (<-address V3824 1)) + +(defun snd (V3825) (<-address V3825 2)) + +(defun tuple? (V3826) (and (absvector? V3826) (= shen.tuple (trap-error (<-address V3826 0) (lambda Z3827 shen.not-tuple))))) + +(defun append (V3832 V3833) (cond ((= () V3832) V3833) ((cons? V3832) (cons (hd V3832) (append (tl V3832) V3833))) (true (simple-error "attempt to append a non-list")))) + +(defun @v (V3834 V3835) (let W3836 (limit V3835) (let W3837 (vector (+ W3836 1)) (let W3838 (vector-> W3837 1 V3834) (if (= W3836 0) W3838 (shen.@v-help V3835 1 W3836 W3838)))))) + +(defun shen.@v-help (V3840 V3841 V3842 V3843) (cond ((= V3841 V3842) (shen.copyfromvector V3840 V3843 V3842 (+ V3842 1))) (true (shen.@v-help V3840 (+ V3841 1) V3842 (shen.copyfromvector V3840 V3843 V3841 (+ V3841 1)))))) + +(defun shen.copyfromvector (V3844 V3845 V3846 V3847) (trap-error (vector-> V3845 V3847 (<-vector V3844 V3846)) (lambda Z3848 V3845))) + +(defun hdv (V3849) (trap-error (<-vector V3849 1) (lambda Z3850 (simple-error "hdv needs a non-empty vector as an argument +")))) + +(defun tlv (V3851) (let W3852 (limit V3851) (if (= W3852 0) (simple-error "cannot take the tail of the empty vector +") (if (= W3852 1) (vector 0) (let W3853 (vector (- W3852 1)) (shen.tlv-help V3851 2 W3852 (vector (- W3852 1)))))))) + +(defun shen.tlv-help (V3855 V3856 V3857 V3858) (cond ((= V3856 V3857) (shen.copyfromvector V3855 V3858 V3857 (- V3857 1))) (true (shen.tlv-help V3855 (+ V3856 1) V3857 (shen.copyfromvector V3855 V3858 V3856 (- V3856 1)))))) + +(defun assoc (V3870 V3871) (cond ((= () V3871) ()) ((and (cons? V3871) (and (cons? (hd V3871)) (= V3870 (hd (hd V3871))))) (hd V3871)) ((cons? V3871) (assoc V3870 (tl V3871))) (true (simple-error "attempt to search a non-list with assoc +")))) + +(defun shen.assoc-set (V3875 V3876 V3877) (cond ((= () V3877) (cons (cons V3875 V3876) ())) ((and (cons? V3877) (and (cons? (hd V3877)) (= V3875 (hd (hd V3877))))) (cons (cons (hd (hd V3877)) V3876) (tl V3877))) ((cons? V3877) (cons (hd V3877) (shen.assoc-set V3875 V3876 (tl V3877)))) (true (shen.f-error shen.assoc-set)))) + +(defun shen.assoc-rm (V3881 V3882) (cond ((= () V3882) ()) ((and (cons? V3882) (and (cons? (hd V3882)) (= V3881 (hd (hd V3882))))) (tl V3882)) ((cons? V3882) (cons (hd V3882) (shen.assoc-rm V3881 (tl V3882)))) (true (shen.f-error shen.assoc-rm)))) + +(defun boolean? (V3885) (cond ((= true V3885) true) ((= false V3885) true) (true false))) + +(defun nl (V3886) (cond ((= 0 V3886) 0) (true (do (pr " +" (stoutput)) (nl (- V3886 1)))))) + +(defun difference (V3893 V3894) (cond ((= () V3893) ()) ((cons? V3893) (if (element? (hd V3893) V3894) (difference (tl V3893) V3894) (cons (hd V3893) (difference (tl V3893) V3894)))) (true (simple-error "attempt to find the difference with a non-list +")))) + +(defun do (V3895 V3896) V3896) + +(defun element? (V3908 V3909) (cond ((= () V3909) false) ((and (cons? V3909) (= V3908 (hd V3909))) true) ((cons? V3909) (element? V3908 (tl V3909))) (true (simple-error "attempt to find an element in a non-list +")))) + +(defun empty? (V3912) (cond ((= () V3912) true) (true false))) + +(defun put (V3923 V3924 V3925 V3926) (let W3927 (trap-error (shen.<-dict V3926 V3923) (lambda Z3928 ())) (let W3929 (shen.assoc-set V3924 V3925 W3927) (let W3930 (shen.dict-> V3926 V3923 W3929) V3925)))) + +(defun unput (V3931 V3932 V3933) (let W3934 (trap-error (shen.<-dict V3933 V3931) (lambda Z3935 ())) (let W3936 (shen.assoc-rm V3932 W3934) (let W3937 (shen.dict-> V3933 V3931 W3936) V3931)))) + +(defun get (V3938 V3939 V3940) (let W3941 (trap-error (shen.<-dict V3940 V3938) (lambda Z3942 (simple-error (shen.app V3938 (cn " has no attributes: " (shen.app V3939 " +" shen.s)) shen.a)))) (let W3943 (assoc V3939 W3941) (if (empty? W3943) (simple-error (cn "attribute " (shen.app V3939 (cn " not found for " (shen.app V3938 " +" shen.s)) shen.s))) (tl W3943))))) + +(defun hash (V3944 V3945) (let W3946 (shen.mod (shen.hashkey V3944) V3945) (if (= W3946 0) 1 W3946))) + +(defun shen.hashkey (V3947) (let W3948 (map (lambda Z3949 (string->n Z3949)) (explode V3947)) (shen.prodbutzero W3948 1))) + +(defun shen.prodbutzero (V3950 V3951) (cond ((= () V3950) V3951) ((and (cons? V3950) (= 0 (hd V3950))) (shen.prodbutzero (tl V3950) V3951)) ((cons? V3950) (if (> V3951 10000000000) (shen.prodbutzero (tl V3950) (+ V3951 (hd V3950))) (shen.prodbutzero (tl V3950) (* V3951 (hd V3950))))) (true (shen.f-error shen.prodbutzero)))) + +(defun shen.mod (V3952 V3953) (shen.modh V3952 (shen.multiples V3952 (cons V3953 ())))) + +(defun shen.multiples (V3958 V3959) (cond ((and (cons? V3959) (> (hd V3959) V3958)) (tl V3959)) ((cons? V3959) (shen.multiples V3958 (cons (* 2 (hd V3959)) V3959))) (true (simple-error "implementation error in shen.multiples")))) + +(defun shen.modh (V3966 V3967) (cond ((= 0 V3966) 0) ((= () V3967) V3966) ((and (cons? V3967) (> (hd V3967) V3966)) (if (empty? (tl V3967)) V3966 (shen.modh V3966 (tl V3967)))) ((cons? V3967) (shen.modh (- V3966 (hd V3967)) V3967)) (true (simple-error "implementation error in shen.modh")))) + +(defun head (V3975) (cond ((cons? V3975) (hd V3975)) (true (simple-error "head expects a non-empty list +")))) + +(defun tail (V3980) (cond ((cons? V3980) (tl V3980)) (true (simple-error "tail expects a non-empty list +")))) + +(defun hdstr (V3981) (pos V3981 0)) + +(defun reverse (V3990) (shen.reverse-help V3990 ())) + +(defun shen.reverse-help (V3995 V3996) (cond ((= () V3995) V3996) ((cons? V3995) (shen.reverse-help (tl V3995) (cons (hd V3995) V3996))) (true (simple-error "attempt to reverse a non-list +")))) + +(defun union (V4001 V4002) (cond ((= () V4001) V4002) ((cons? V4001) (if (element? (hd V4001) V4002) (union (tl V4001) V4002) (cons (hd V4001) (union (tl V4001) V4002)))) (true (simple-error "attempt to find the union with a non-list +")))) + +(defun y-or-n? (V4003) (let W4004 (pr (shen.proc-nl V4003) (stoutput)) (let W4005 (pr " (y/n) " (stoutput)) (let W4006 (shen.app (read (stinput)) "" shen.s) (if (= "y" W4006) true (if (= "n" W4006) false (do (pr "please answer y or n +" (stoutput)) (y-or-n? V4003)))))))) + +(defun not (V4007) (if V4007 false true)) + +(defun abort () (simple-error "")) + +(defun subst (V4013 V4014 V4015) (cond ((= V4014 V4015) V4013) ((cons? V4015) (cons (subst V4013 V4014 (hd V4015)) (subst V4013 V4014 (tl V4015)))) (true V4015))) + +(defun explode (V4016) (shen.explode-h (shen.app V4016 "" shen.a))) + +(defun shen.explode-h (V4019) (cond ((= "" V4019) ()) ((shen.+string? V4019) (cons (hdstr V4019) (shen.explode-h (tlstr V4019)))) (true (simple-error "implementation error in explode-h")))) + +(defun shen.for-each (V4021 V4022) (cond ((= () V4022) true) ((cons? V4022) (let W4023 (V4021 (hd V4022)) (shen.for-each V4021 (tl V4022)))) (true (shen.f-error shen.for-each)))) + +(defun map (V4024 V4025) (shen.map-h V4024 V4025 ())) + +(defun shen.map-h (V4026 V4027 V4028) (cond ((= () V4027) (reverse V4028)) ((cons? V4027) (shen.map-h V4026 (tl V4027) (cons (V4026 (hd V4027)) V4028))) (true (shen.f-error shen.map-h)))) + +(defun length (V4029) (shen.length-h V4029 0)) + +(defun shen.length-h (V4034 V4035) (cond ((= () V4034) V4035) (true (shen.length-h (tl V4034) (+ V4035 1))))) + +(defun occurrences (V4041 V4042) (cond ((= V4041 V4042) 1) ((cons? V4042) (+ (occurrences V4041 (hd V4042)) (occurrences V4041 (tl V4042)))) (true 0))) + +(defun integer? (V4049) (and (number? V4049) (let W4050 (shen.abs V4049) (shen.integer-test? W4050 (shen.magless W4050 1))))) + +(defun shen.abs (V4051) (if (> V4051 0) V4051 (- 0 V4051))) + +(defun shen.magless (V4052 V4053) (let W4054 (* V4053 2) (if (> W4054 V4052) V4053 (shen.magless V4052 W4054)))) + +(defun shen.integer-test? (V4058 V4059) (cond ((= 0 V4058) true) ((> 1 V4058) false) (true (let W4060 (- V4058 V4059) (if (> 0 W4060) (integer? V4058) (shen.integer-test? W4060 V4059)))))) + +(defun mapcan (V4067 V4068) (cond ((= () V4068) ()) ((cons? V4068) (append (V4067 (hd V4068)) (mapcan V4067 (tl V4068)))) (true (simple-error "attempt to mapcan over a non-list +")))) + +(defun bound? (V4076) (and (symbol? V4076) (let W4077 (trap-error (value V4076) (lambda Z4078 shen.this-symbol-is-unbound)) (if (= W4077 shen.this-symbol-is-unbound) false true)))) + +(defun inferences () (value shen.*infs*)) + +(defun protect (V4081) V4081) + +(defun stoutput () (value *stoutput*)) + +(defun fail () shen.fail!) + +(defun destroy (V4098) (do (set shen.*sigf* (shen.unassoc V4098 (value shen.*sigf*))) V4098)) + +(defun shen.unassoc (V4108 V4109) (cond ((= () V4109) ()) ((and (cons? V4109) (and (cons? (hd V4109)) (= V4108 (hd (hd V4109))))) (tl V4109)) ((cons? V4109) (cons (hd V4109) (shen.unassoc V4108 (tl V4109)))) (true (simple-error "implementation error in shen.unassoc")))) + +(defun shen.dict (V4162) (cond ((< V4162 1) (simple-error (cn "invalid initial dict size: " (shen.app V4162 "" shen.s)))) (true (let W4163 (absvector (+ 3 V4162)) (let W4164 (address-> W4163 0 shen.dictionary) (let W4165 (address-> W4163 1 V4162) (let W4166 (address-> W4163 2 0) (let W4167 (shen.fillvector W4163 3 (+ 2 V4162) ()) W4163)))))))) + +(defun shen.dict-capacity (V4170) (<-address V4170 1)) + +(defun shen.dict-count (V4171) (<-address V4171 2)) + +(defun shen.dict-count-> (V4172 V4173) (address-> V4172 2 V4173)) + +(defun shen.<-dict-bucket (V4174 V4175) (<-address V4174 (+ 3 V4175))) + +(defun shen.dict-bucket-> (V4176 V4177 V4178) (address-> V4176 (+ 3 V4177) V4178)) + +(defun shen.dict-update-count (V4179 V4180 V4181) (let W4182 (- (length V4181) (length V4180)) (shen.dict-count-> V4179 (+ W4182 (shen.dict-count V4179))))) + +(defun shen.dict-> (V4183 V4184 V4185) (let W4186 (hash V4184 (shen.dict-capacity V4183)) (let W4187 (shen.<-dict-bucket V4183 W4186) (let W4188 (shen.assoc-set V4184 V4185 W4187) (let W4189 (shen.dict-bucket-> V4183 W4186 W4188) (let W4190 (shen.dict-update-count V4183 W4187 W4188) V4185)))))) + +(defun shen.<-dict (V4191 V4192) (let W4193 (hash V4192 (shen.dict-capacity V4191)) (let W4194 (shen.<-dict-bucket V4191 W4193) (let W4195 (assoc V4192 W4194) (if (empty? W4195) (simple-error (cn "value " (shen.app V4192 " not found in dict +" shen.a))) (tl W4195)))))) + +(defun shen. (V3365) (let W3366 (if (cons? V3365) (let W3367 (head V3365) (let W3368 (tail V3365) (let W3369 (shen. W3368) (if (shen.parse-failure? W3369) (shen.parse-failure) (let W3370 (shen.<-out W3369) (let W3371 (shen.in-> W3369) (shen.comb W3371 (let W3372 (shen.rules->prolog W3367 W3370) (shen.remember-datatype W3367 (fn W3367)))))))))) (shen.parse-failure)) (if (shen.parse-failure? W3366) (shen.parse-failure) W3366))) + +(defun shen.remember-datatype (V3373 V3374) (do (set shen.*datatypes* (shen.assoc-> V3373 V3374 (value shen.*datatypes*))) (do (set shen.*alldatatypes* (shen.assoc-> V3373 V3374 (value shen.*alldatatypes*))) V3373))) + +(defun shen. (V3375) (let W3376 (let W3377 (shen. V3375) (if (shen.parse-failure? W3377) (shen.parse-failure) (let W3378 (shen.<-out W3377) (let W3379 (shen.in-> W3377) (let W3380 (shen. W3379) (if (shen.parse-failure? W3380) (shen.parse-failure) (let W3381 (shen.<-out W3380) (let W3382 (shen.in-> W3380) (shen.comb W3382 (append W3378 W3381)))))))))) (if (shen.parse-failure? W3376) (let W3383 (let W3384 ( V3375) (if (shen.parse-failure? W3384) (shen.parse-failure) (let W3385 (shen.<-out W3384) (let W3386 (shen.in-> W3384) (shen.comb W3386 (if (empty? W3385) () (simple-error (cn "datatype syntax error here: + " (shen.app W3385 " + ..." shen.r))))))))) (if (shen.parse-failure? W3383) (shen.parse-failure) W3383)) W3376))) + +(defun shen. (V3387) (let W3388 (let W3389 (shen. V3387) (if (shen.parse-failure? W3389) (shen.parse-failure) (let W3390 (shen.<-out W3389) (let W3391 (shen.in-> W3389) (shen.comb W3391 W3390))))) (if (shen.parse-failure? W3388) (let W3392 (let W3393 (shen. V3387) (if (shen.parse-failure? W3393) (shen.parse-failure) (let W3394 (shen.<-out W3393) (let W3395 (shen.in-> W3393) (shen.comb W3395 W3394))))) (if (shen.parse-failure? W3392) (shen.parse-failure) W3392)) W3388))) + +(defun shen. (V3396) (let W3397 (let W3398 (shen. V3396) (if (shen.parse-failure? W3398) (shen.parse-failure) (let W3399 (shen.<-out W3398) (let W3400 (shen.in-> W3398) (let W3401 (shen. W3400) (if (shen.parse-failure? W3401) (shen.parse-failure) (let W3402 (shen.<-out W3401) (let W3403 (shen.in-> W3401) (let W3404 (shen. W3403) (if (shen.parse-failure? W3404) (shen.parse-failure) (let W3405 (shen.in-> W3404) (let W3406 (shen. W3405) (if (shen.parse-failure? W3406) (shen.parse-failure) (let W3407 (shen.<-out W3406) (let W3408 (shen.in-> W3406) (let W3409 (shen. W3408) (if (shen.parse-failure? W3409) (shen.parse-failure) (let W3410 (shen.in-> W3409) (shen.comb W3410 (cons (cons W3399 (cons W3402 (cons W3407 ()))) ())))))))))))))))))))) (if (shen.parse-failure? W3397) (shen.parse-failure) W3397))) + +(defun shen. (V3411) (let W3412 (let W3413 (shen. V3411) (if (shen.parse-failure? W3413) (shen.parse-failure) (let W3414 (shen.<-out W3413) (let W3415 (shen.in-> W3413) (let W3416 (shen. W3415) (if (shen.parse-failure? W3416) (shen.parse-failure) (let W3417 (shen.<-out W3416) (let W3418 (shen.in-> W3416) (let W3419 (shen. W3418) (if (shen.parse-failure? W3419) (shen.parse-failure) (let W3420 (shen.in-> W3419) (let W3421 (shen. W3420) (if (shen.parse-failure? W3421) (shen.parse-failure) (let W3422 (shen.<-out W3421) (let W3423 (shen.in-> W3421) (let W3424 (shen. W3423) (if (shen.parse-failure? W3424) (shen.parse-failure) (let W3425 (shen.in-> W3424) (shen.comb W3425 (shen.lr-rule W3414 W3417 (cons () (cons W3422 ())))))))))))))))))))))) (if (shen.parse-failure? W3412) (shen.parse-failure) W3412))) + +(defun shen. (V3426) (let W3427 (let W3428 (shen. V3426) (if (shen.parse-failure? W3428) (shen.parse-failure) (let W3429 (shen.<-out W3428) (let W3430 (shen.in-> W3428) (let W3431 (shen. W3430) (if (shen.parse-failure? W3431) (shen.parse-failure) (let W3432 (shen.in-> W3431) (let W3433 (shen. W3432) (if (shen.parse-failure? W3433) (shen.parse-failure) (let W3434 (shen.<-out W3433) (let W3435 (shen.in-> W3433) (shen.comb W3435 (cons (cons () (cons W3429 ())) W3434))))))))))))) (if (shen.parse-failure? W3427) (let W3436 (let W3437 (shen. V3426) (if (shen.parse-failure? W3437) (shen.parse-failure) (let W3438 (shen.<-out W3437) (let W3439 (shen.in-> W3437) (let W3440 (shen. W3439) (if (shen.parse-failure? W3440) (shen.parse-failure) (let W3441 (shen.in-> W3440) (shen.comb W3441 (cons (cons () (cons W3438 ())) ()))))))))) (if (shen.parse-failure? W3436) (shen.parse-failure) W3436)) W3427))) + +(defun shen. (V3442) (let W3443 (let W3444 (shen. V3442) (if (shen.parse-failure? W3444) (shen.parse-failure) (let W3445 (shen.<-out W3444) (let W3446 (shen.in-> W3444) (if (shen.hds=? W3446 >>) (let W3447 (tail W3446) (let W3448 (shen. W3447) (if (shen.parse-failure? W3448) (shen.parse-failure) (let W3449 (shen.<-out W3448) (let W3450 (shen.in-> W3448) (shen.comb W3450 (cons W3445 (cons W3449 ())))))))) (shen.parse-failure)))))) (if (shen.parse-failure? W3443) (let W3451 (let W3452 (shen. V3442) (if (shen.parse-failure? W3452) (shen.parse-failure) (let W3453 (shen.<-out W3452) (let W3454 (shen.in-> W3452) (shen.comb W3454 (cons () (cons W3453 ()))))))) (if (shen.parse-failure? W3451) (shen.parse-failure) W3451)) W3443))) + +(defun shen. (V3455) (let W3456 (let W3457 (shen. V3455) (if (shen.parse-failure? W3457) (shen.parse-failure) (let W3458 (shen.<-out W3457) (let W3459 (shen.in-> W3457) (let W3460 (shen. W3459) (if (shen.parse-failure? W3460) (shen.parse-failure) (let W3461 (shen.in-> W3460) (let W3462 (shen. W3461) (if (shen.parse-failure? W3462) (shen.parse-failure) (let W3463 (shen.<-out W3462) (let W3464 (shen.in-> W3462) (shen.comb W3464 (cons W3458 W3463))))))))))))) (if (shen.parse-failure? W3456) (let W3465 (let W3466 ( V3455) (if (shen.parse-failure? W3466) (shen.parse-failure) (let W3467 (shen.in-> W3466) (shen.comb W3467 ())))) (if (shen.parse-failure? W3465) (shen.parse-failure) W3465)) W3456))) + +(defun shen. (V3468) (let W3469 (if (shen.hds=? V3468 !) (let W3470 (tail V3468) (shen.comb W3470 !)) (shen.parse-failure)) (if (shen.parse-failure? W3469) (let W3471 (let W3472 (shen. V3468) (if (shen.parse-failure? W3472) (shen.parse-failure) (let W3473 (shen.<-out W3472) (let W3474 (shen.in-> W3472) (if (shen.hds=? W3474 >>) (let W3475 (tail W3474) (let W3476 (shen. W3475) (if (shen.parse-failure? W3476) (shen.parse-failure) (let W3477 (shen.<-out W3476) (let W3478 (shen.in-> W3476) (shen.comb W3478 (cons W3473 (cons W3477 ())))))))) (shen.parse-failure)))))) (if (shen.parse-failure? W3471) (let W3479 (let W3480 (shen. V3468) (if (shen.parse-failure? W3480) (shen.parse-failure) (let W3481 (shen.<-out W3480) (let W3482 (shen.in-> W3480) (shen.comb W3482 (cons () (cons W3481 ()))))))) (if (shen.parse-failure? W3479) (shen.parse-failure) W3479)) W3471)) W3469))) + +(defun shen. (V3483) (let W3484 (let W3485 (shen. V3483) (if (shen.parse-failure? W3485) (shen.parse-failure) (let W3486 (shen.<-out W3485) (let W3487 (shen.in-> W3485) (let W3488 (shen. W3487) (if (shen.parse-failure? W3488) (shen.parse-failure) (let W3489 (shen.in-> W3488) (let W3490 (shen. W3489) (if (shen.parse-failure? W3490) (shen.parse-failure) (let W3491 (shen.<-out W3490) (let W3492 (shen.in-> W3490) (shen.comb W3492 (cons W3486 W3491))))))))))))) (if (shen.parse-failure? W3484) (let W3493 (let W3494 (shen. V3483) (if (shen.parse-failure? W3494) (shen.parse-failure) (let W3495 (shen.<-out W3494) (let W3496 (shen.in-> W3494) (shen.comb W3496 (cons W3495 ())))))) (if (shen.parse-failure? W3493) (let W3497 (let W3498 ( V3483) (if (shen.parse-failure? W3498) (shen.parse-failure) (let W3499 (shen.in-> W3498) (shen.comb W3499 ())))) (if (shen.parse-failure? W3497) (shen.parse-failure) W3497)) W3493)) W3484))) + +(defun shen. (V3500) (let W3501 (if (cons? V3500) (let W3502 (head V3500) (let W3503 (tail V3500) (if (= W3502 (intern ",")) (shen.comb W3503 shen.skip) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W3501) (shen.parse-failure) W3501))) + +(defun shen. (V3504) (let W3505 (let W3506 (shen. V3504) (if (shen.parse-failure? W3506) (shen.parse-failure) (let W3507 (shen.<-out W3506) (let W3508 (shen.in-> W3506) (let W3509 (shen. W3508) (if (shen.parse-failure? W3509) (shen.parse-failure) (let W3510 (shen.in-> W3509) (let W3511 (shen. W3510) (if (shen.parse-failure? W3511) (shen.parse-failure) (let W3512 (shen.<-out W3511) (let W3513 (shen.in-> W3511) (shen.comb W3513 (cons (shen.curry W3507) (cons (intern ":") (cons (shen.rectify-type W3512) ()))))))))))))))) (if (shen.parse-failure? W3505) (let W3514 (let W3515 (shen. V3504) (if (shen.parse-failure? W3515) (shen.parse-failure) (let W3516 (shen.<-out W3515) (let W3517 (shen.in-> W3515) (shen.comb W3517 W3516))))) (if (shen.parse-failure? W3514) (shen.parse-failure) W3514)) W3505))) + +(defun shen. (V3518) (let W3519 (if (cons? V3518) (let W3520 (head V3518) (let W3521 (tail V3518) (if (= W3520 (intern ":")) (shen.comb W3521 shen.skip) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W3519) (shen.parse-failure) W3519))) + +(defun shen. (V3522) (let W3523 (let W3524 (shen. V3522) (if (shen.parse-failure? W3524) (shen.parse-failure) (let W3525 (shen.<-out W3524) (let W3526 (shen.in-> W3524) (let W3527 (shen. W3526) (if (shen.parse-failure? W3527) (shen.parse-failure) (let W3528 (shen.<-out W3527) (let W3529 (shen.in-> W3527) (shen.comb W3529 (cons W3525 W3528)))))))))) (if (shen.parse-failure? W3523) (let W3530 (let W3531 ( V3522) (if (shen.parse-failure? W3531) (shen.parse-failure) (let W3532 (shen.in-> W3531) (shen.comb W3532 ())))) (if (shen.parse-failure? W3530) (shen.parse-failure) W3530)) W3523))) + +(defun shen. (V3533) (let W3534 (if (shen.hds=? V3533 if) (let W3535 (tail V3533) (if (cons? W3535) (let W3536 (head W3535) (let W3537 (tail W3535) (shen.comb W3537 (cons if (cons W3536 ()))))) (shen.parse-failure))) (shen.parse-failure)) (if (shen.parse-failure? W3534) (let W3538 (if (shen.hds=? V3533 let) (let W3539 (tail V3533) (if (cons? W3539) (let W3540 (head W3539) (let W3541 (tail W3539) (if (cons? W3541) (let W3542 (head W3541) (let W3543 (tail W3541) (shen.comb W3543 (cons let (cons W3540 (cons W3542 ())))))) (shen.parse-failure)))) (shen.parse-failure))) (shen.parse-failure)) (if (shen.parse-failure? W3538) (let W3544 (if (shen.hds=? V3533 ctxt) (let W3545 (tail V3533) (if (cons? W3545) (let W3546 (head W3545) (let W3547 (tail W3545) (if (variable? W3546) (shen.comb W3547 (cons ctxt (cons W3546 ()))) (shen.parse-failure)))) (shen.parse-failure))) (shen.parse-failure)) (if (shen.parse-failure? W3544) (shen.parse-failure) W3544)) W3538)) W3534))) + +(defun shen.lr-rule (V3554 V3555 V3556) (cond ((and (cons? V3556) (and (= () (hd V3556)) (and (cons? (tl V3556)) (= () (tl (tl V3556)))))) (let W3557 (gensym P) (let W3558 (cons (tl V3556) (cons W3557 ())) (let W3559 (cons (shen.coll-formulae V3555) (cons W3557 ())) (let W3560 (cons V3554 (cons (cons W3559 ()) (cons W3558 ()))) (let W3561 (cons V3554 (cons V3555 (cons V3556 ()))) (cons W3561 (cons W3560 ())))))))) (true (simple-error "implementation error in shen.lr-rule")))) + +(defun shen.coll-formulae (V3564) (cond ((= () V3564) ()) ((and (cons? V3564) (and (cons? (hd V3564)) (and (= () (hd (hd V3564))) (and (cons? (tl (hd V3564))) (= () (tl (tl (hd V3564)))))))) (cons (hd (tl (hd V3564))) (shen.coll-formulae (tl V3564)))) (true (simple-error "implementation error in shen.coll-formulae")))) + +(defun shen. (V3565) (let W3566 (if (cons? V3565) (let W3567 (head V3565) (let W3568 (tail V3565) (if (not (shen.key-in-sequent-calculus? W3567)) (shen.comb W3568 (macroexpand W3567)) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W3566) (shen.parse-failure) W3566))) + +(defun shen.key-in-sequent-calculus? (V3569) (or (element? V3569 (cons >> (cons (intern ";") (cons (intern ",") (cons (intern ":") (cons <-- ())))))) (or (shen.sng? V3569) (shen.dbl? V3569)))) + +(defun shen. (V3570) (let W3571 (let W3572 (shen. V3570) (if (shen.parse-failure? W3572) (shen.parse-failure) (let W3573 (shen.<-out W3572) (let W3574 (shen.in-> W3572) (shen.comb W3574 W3573))))) (if (shen.parse-failure? W3571) (shen.parse-failure) W3571))) + +(defun shen. (V3575) (let W3576 (if (cons? V3575) (let W3577 (head V3575) (let W3578 (tail V3575) (if (shen.dbl? W3577) (shen.comb W3578 W3577) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W3576) (shen.parse-failure) W3576))) + +(defun shen. (V3579) (let W3580 (if (cons? V3579) (let W3581 (head V3579) (let W3582 (tail V3579) (if (shen.sng? W3581) (shen.comb W3582 W3581) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W3580) (shen.parse-failure) W3580))) + +(defun shen.sng? (V3583) (and (symbol? V3583) (shen.sng-h? (str V3583)))) + +(defun shen.sng-h? (V3586) (cond ((= "___" V3586) true) ((and (shen.+string? V3586) (= "_" (hdstr V3586))) (shen.sng-h? (tlstr V3586))) (true false))) + +(defun shen.dbl? (V3587) (and (symbol? V3587) (shen.dbl-h? (str V3587)))) + +(defun shen.dbl-h? (V3590) (cond ((= "===" V3590) true) ((and (shen.+string? V3590) (= "=" (hdstr V3590))) (shen.dbl-h? (tlstr V3590))) (true false))) + +(defun shen.rules->prolog (V3591 V3592) (let W3593 (mapcan (lambda Z3594 (shen.rule->clause Z3594)) V3592) (let W3595 (cons defprolog (cons V3591 W3593)) (eval W3595)))) + +(defun shen.rule->clause (V3596) (cond ((and (cons? V3596) (and (cons? (tl V3596)) (and (cons? (tl (tl V3596))) (and (cons? (hd (tl (tl V3596)))) (and (cons? (tl (hd (tl (tl V3596))))) (and (= () (tl (tl (hd (tl (tl V3596)))))) (= () (tl (tl (tl V3596)))))))))) (let W3597 (shen.extract-vars (hd (tl (hd (tl (tl V3596)))))) (append (shen.rule->head (hd (tl (hd (tl (tl V3596)))))) (append (cons <-- ()) (shen.rule->body W3597 Assumptions (hd V3596) (hd (tl V3596)) (hd (hd (tl (tl V3596))))))))) (true (shen.f-error shen.rule->clause)))) + +(defun shen.rule->head (V3598) (cons (shen.macro-@ch V3598) (cons Assumptions ()))) + +(defun shen.macro-@ch (V3599) (cons shen.@ch (cons V3599 ()))) + +(defun shen.macro-@c (V3600) (cons shen.@c (cons V3600 ()))) + +(defun shen.rule->body (V3601 V3602 V3603 V3604 V3605) (cond ((= () V3605) (shen.side-conditions->goals () V3601 V3602 V3603 V3604)) ((and (= () V3604) (and (cons? V3605) (= () (tl V3605)))) (let W3606 (shen.passive-variables (hd V3605) V3601) (let W3607 (shen.remove-bystanders V3601 (hd V3605)) (cons (shen.specialise-member (hd V3605) V3602 W3607 W3606) (shen.side-conditions->goals () V3601 V3602 V3603 ()))))) ((cons? V3605) (let W3608 (gensym NewAssumptions) (let W3609 (shen.passive-variables (hd V3605) V3601) (let W3610 (shen.remove-bystanders V3601 (hd V3605)) (cons (shen.specialise-consume (hd V3605) V3602 W3610 W3609 W3608) (shen.rule->body (append V3601 W3609) W3608 V3603 V3604 (tl V3605))))))) (true (shen.f-error shen.rule->body)))) + +(defun shen.specialise-member (V3611 V3612 V3613 V3614) (let W3615 (gensym shen.member) (let W3616 (shen.member-clause W3615 V3611 V3613 V3614) (cons W3615 (cons V3612 (append V3613 V3614)))))) + +(defun shen.remove-bystanders (V3619 V3620) (cond ((= () V3619) ()) ((and (cons? V3619) (shen.occurs-check? (hd V3619) V3620)) (cons (hd V3619) (shen.remove-bystanders (tl V3619) V3620))) ((cons? V3619) (shen.remove-bystanders (tl V3619) V3620)) (true (shen.f-error shen.remove-bystanders)))) + +(defun shen.member-clause (V3621 V3622 V3623 V3624) (let W3625 (shen.nvars (length V3624)) (let W3626 (append (cons (cons - (cons (cons cons (cons (shen.macro-@ch V3622) (cons _ ()))) ())) ()) (append V3623 (append W3625 (append (cons <-- ()) (append (shen.passive-bind V3624 W3625) (cons (intern ";") ())))))) (let W3627 (let W3628 (gensym Hypotheses) (let W3629 (append V3623 V3624) (let W3630 (append (cons (cons - (cons (cons cons (cons _ (cons W3628 ()))) ())) ()) W3629) (let W3631 (cons (cons V3621 (cons W3628 W3629)) ()) (append W3630 (append (cons <-- ()) (append W3631 (cons (intern ";") ())))))))) (let W3632 (cons defprolog (cons V3621 (append W3626 W3627))) (eval W3632)))))) + +(defun shen.nvars (V3633) (cond ((= 0 V3633) ()) (true (cons (gensym NewV) (shen.nvars (- V3633 1)))))) + +(defun shen.passive-bind (V3634 V3635) (cond ((and (= () V3634) (= () V3635)) ()) ((and (cons? V3634) (cons? V3635)) (cons (cons bind (cons (hd V3635) (cons (hd V3634) ()))) (shen.passive-bind (tl V3634) (tl V3635)))) (true (shen.f-error shen.passive-bind)))) + +(defun shen.specialise-consume (V3636 V3637 V3638 V3639 V3640) (let W3641 (gensym shen.consume) (let W3642 (shen.consume-clause W3641 V3636 V3638 V3639 V3640) (cons W3641 (cons V3637 (cons V3640 (append V3638 V3639))))))) + +(defun shen.consume-clause (V3643 V3644 V3645 V3646 V3647) (let W3648 (shen.nvars (length V3646)) (let W3649 (gensym Assumption) (let W3650 (cons (cons - (cons (cons cons (cons (shen.macro-@ch V3644) (cons W3649 ()))) ())) (cons V3647 (append V3645 (append W3648 (append (cons <-- ()) (append (shen.passive-bind V3646 W3648) (cons (cons bind (cons V3647 (cons W3649 ()))) (cons (intern ";") ())))))))) (let W3651 (let W3652 (gensym Hypotheses) (let W3653 (append V3645 V3646) (let W3654 (gensym Assumptions) (let W3655 (cons (cons - (cons (cons cons (cons W3649 (cons W3652 ()))) ())) (cons (cons cons (cons W3654 (cons V3647 ()))) W3653)) (let W3656 (cons (cons bind (cons W3654 (cons W3649 ()))) (cons (cons V3643 (cons W3652 (cons V3647 W3653))) ())) (append W3655 (append (cons <-- ()) (append W3656 (cons (intern ";") ()))))))))) (let W3657 (cons defprolog (cons V3643 (append W3650 W3651))) (eval W3657))))))) + +(defun shen.passive-variables (V3658 V3659) (difference (shen.extract-vars V3658) V3659)) + +(defun shen.side-conditions->goals (V3662 V3663 V3664 V3665 V3666) (cond ((= () V3665) (shen.premises->goals V3662 V3664 V3666)) ((and (cons? V3665) (and (cons? (hd V3665)) (and (= if (hd (hd V3665))) (and (cons? (tl (hd V3665))) (= () (tl (tl (hd V3665)))))))) (cons (cons when (tl (hd V3665))) (shen.side-conditions->goals V3662 V3663 V3664 (tl V3665) V3666))) ((and (cons? V3665) (and (cons? (hd V3665)) (and (= let (hd (hd V3665))) (and (cons? (tl (hd V3665))) (and (cons? (tl (tl (hd V3665)))) (= () (tl (tl (tl (hd V3665)))))))))) (if (element? (hd (tl (hd V3665))) V3663) (cons (cons is! (tl (hd V3665))) (shen.side-conditions->goals V3662 V3663 V3664 (tl V3665) V3666)) (cons (cons bind (tl (hd V3665))) (shen.side-conditions->goals V3662 (cons (hd (tl (hd V3665))) V3663) V3664 (tl V3665) V3666)))) ((and (cons? V3665) (and (cons? (hd V3665)) (and (= ctxt (hd (hd V3665))) (and (cons? (tl (hd V3665))) (= () (tl (tl (hd V3665)))))))) (if (element? (hd (tl (hd V3665))) V3663) (shen.side-conditions->goals (cons (hd (tl (hd V3665))) V3662) V3663 V3664 (tl V3665) V3666) (cons (cons bind (cons (hd (tl (hd V3665))) (cons V3664 ()))) (shen.side-conditions->goals (cons (hd (tl (hd V3665))) V3662) (cons (hd (tl (hd V3665))) V3663) (hd (tl (hd V3665))) (tl V3665) V3666)))) (true (shen.f-error shen.side-conditions->goals)))) + +(defun shen.premises->goals (V3671 V3672 V3673) (cond ((= () V3673) (cons (intern ";") ())) ((and (cons? V3673) (= ! (hd V3673))) (cons ! (shen.premises->goals V3671 V3672 (tl V3673)))) ((and (cons? V3673) (= fail (hd V3673))) (cons (cons when (cons false ())) (shen.premises->goals V3671 V3672 (tl V3673)))) ((and (cons? V3673) (and (cons? (hd V3673)) (and (cons? (tl (hd V3673))) (= () (tl (tl (hd V3673))))))) (cons (cons shen.system-S (cons (shen.macro-@c (hd (tl (hd V3673)))) (cons (shen.construct-context V3671 (hd (hd V3673)) V3672) ()))) (shen.premises->goals V3671 V3672 (tl V3673)))) (true (shen.f-error shen.premises->goals)))) + +(defun shen.construct-context (V3677 V3678 V3679) (cond ((= () V3678) V3679) ((and (cons? V3678) (and (= () (tl V3678)) (element? (hd V3678) V3677))) (hd V3678)) ((cons? V3678) (cons cons (cons (shen.macro-@c (hd V3678)) (cons (shen.construct-context V3677 (tl V3678) V3679) ())))) (true (shen.f-error shen.construct-context)))) + +(defun compile (V112 V113) (let W114 (V112 V113) (if (shen.parse-failure? W114) (simple-error "parse failure +") (if (shen.partial-parse-failure? W114) (do (set shen.*residue* (shen.in-> W114)) (shen.raise-syntax-error (value shen.*residue*))) (shen.<-out W114))))) + +(defun shen.raise-syntax-error (V115) (simple-error (shen.proc-nl (cn "syntax error here: " (shen.syntax-error-message (value *maximum-print-sequence-size*) 0 V115))))) + +(defun shen.syntax-error-message (V123 V124 V125) (cond ((= () V125) " +") ((= V123 V124) "...etc +") ((cons? V125) (cn (shen.app (hd V125) " " shen.s) (shen.syntax-error-message V123 (+ V124 1) (tl V125)))) (true (shen.f-error shen.syntax-error-message)))) + +(defun shen.parse-failure? (V126) (= V126 (fail))) + +(defun shen.partial-parse-failure? (V127) (cons? (shen.in-> V127))) + +(defun shen.yacc->shen (V131) (compile (lambda Z132 (shen. Z132)) V131)) + +(defun shen. (V133) (let W134 (if (cons? V133) (let W135 (head V133) (let W136 (tail V133) (let W137 (shen. W136) (if (shen.parse-failure? W137) (shen.parse-failure) (let W138 (shen.<-out W137) (let W139 (shen.in-> W137) (let W140 (shen. W139) (if (shen.parse-failure? W140) (shen.parse-failure) (let W141 (shen.<-out W140) (let W142 (shen.in-> W140) (shen.comb W142 (let W143 (gensym S) (let W144 (append (cons define (cons W135 ())) (append W138 (cons W143 (cons -> (cons (shen.c-rules->shen W138 W143 W141) ()))))) W144))))))))))))) (shen.parse-failure)) (if (shen.parse-failure? W134) (shen.parse-failure) W134))) + +(defun shen. (V145) (let W146 (if (cons? V145) (let W147 (head V145) (let W148 (tail V145) (if (shen.ccons? W148) (let W149 (head W148) (let W150 (tail W148) (if (shen.hds=? W149 list) (let W151 (tail W149) (if (cons? W151) (let W152 (head W151) (let W153 (tail W151) (let W154 ( W153) (if (shen.parse-failure? W154) (shen.parse-failure) (let W155 (shen.in-> W154) (if (shen.hds=? W150 ==>) (let W156 (tail W150) (if (cons? W156) (let W157 (head W156) (let W158 (tail W156) (if (cons? W158) (let W159 (head W158) (let W160 (tail W158) (if (and (= { W147) (= } W159)) (shen.comb W160 (cons { (cons (cons list (cons W152 ())) (cons --> (cons (cons str (cons (cons list (cons W152 ())) (cons W157 ()))) (cons } ())))))) (shen.parse-failure)))) (shen.parse-failure)))) (shen.parse-failure))) (shen.parse-failure))))))) (shen.parse-failure))) (shen.parse-failure)))) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W146) (let W161 (let W162 ( V145) (if (shen.parse-failure? W162) (shen.parse-failure) (let W163 (shen.in-> W162) (shen.comb W163 ())))) (if (shen.parse-failure? W161) (shen.parse-failure) W161)) W146))) + +(defun shen. (V164) (let W165 (let W166 (shen. V164) (if (shen.parse-failure? W166) (shen.parse-failure) (let W167 (shen.<-out W166) (let W168 (shen.in-> W166) (let W169 (shen. W168) (if (shen.parse-failure? W169) (shen.parse-failure) (let W170 (shen.<-out W169) (let W171 (shen.in-> W169) (shen.comb W171 (cons W167 W170)))))))))) (if (shen.parse-failure? W165) (let W172 (let W173 ( V164) (if (shen.parse-failure? W173) (shen.parse-failure) (let W174 (shen.<-out W173) (let W175 (shen.in-> W173) (shen.comb W175 (if (empty? W174) () (simple-error (cn "YACC syntax error here: + " (shen.app W174 " + ..." shen.r))))))))) (if (shen.parse-failure? W172) (shen.parse-failure) W172)) W165))) + +(defun shen. (V176) (let W177 (let W178 (shen. V176) (if (shen.parse-failure? W178) (shen.parse-failure) (let W179 (shen.<-out W178) (let W180 (shen.in-> W178) (let W181 (shen. W180) (if (shen.parse-failure? W181) (shen.parse-failure) (let W182 (shen.<-out W181) (let W183 (shen.in-> W181) (let W184 (shen. W183) (if (shen.parse-failure? W184) (shen.parse-failure) (let W185 (shen.in-> W184) (shen.comb W185 (cons W179 (cons W182 ())))))))))))))) (if (shen.parse-failure? W177) (let W186 (let W187 (shen. V176) (if (shen.parse-failure? W187) (shen.parse-failure) (let W188 (shen.<-out W187) (let W189 (shen.in-> W187) (let W190 (shen. W189) (if (shen.parse-failure? W190) (shen.parse-failure) (let W191 (shen.in-> W190) (shen.comb W191 (cons W188 (cons (shen.autocomplete W188) ())))))))))) (if (shen.parse-failure? W186) (shen.parse-failure) W186)) W177))) + +(defun shen.autocomplete (V192) (cond ((and (cons? V192) (and (= () (tl V192)) (shen.non-terminal? (hd V192)))) (hd V192)) ((and (cons? V192) (shen.non-terminal? (hd V192))) (cons append (cons (hd V192) (cons (shen.autocomplete (tl V192)) ())))) ((cons? V192) (cons cons (cons (shen.autocomplete (hd V192)) (cons (shen.autocomplete (tl V192)) ())))) (true V192))) + +(defun shen.non-terminal? (V193) (and (symbol? V193) (let W194 (explode V193) (compile (lambda Z195 (shen. Z195)) W194)))) + +(defun shen. (V196) (let W197 (let W198 (shen. V196) (if (shen.parse-failure? W198) (shen.parse-failure) (let W199 (shen.in-> W198) (let W200 (shen. W199) (if (shen.parse-failure? W200) (shen.parse-failure) (let W201 (shen.in-> W200) (shen.comb W201 true))))))) (if (shen.parse-failure? W197) (let W202 (let W203 (shen. V196) (if (shen.parse-failure? W203) (shen.parse-failure) (let W204 (shen.in-> W203) (shen.comb W204 true)))) (if (shen.parse-failure? W202) (let W205 (let W206 ( V196) (if (shen.parse-failure? W206) (shen.parse-failure) (let W207 (shen.in-> W206) (shen.comb W207 false)))) (if (shen.parse-failure? W205) (shen.parse-failure) W205)) W202)) W197))) + +(defun shen. (V208) (let W209 (let W210 (shen. V208) (if (shen.parse-failure? W210) (shen.parse-failure) (let W211 (shen.in-> W210) (if (shen.hds=? W211 ".") (let W212 (tail W211) (let W213 (shen. W212) (if (shen.parse-failure? W213) (shen.parse-failure) (let W214 (shen.in-> W213) (shen.comb W214 shen.skip))))) (shen.parse-failure))))) (if (shen.parse-failure? W209) (let W215 (let W216 (shen. V208) (if (shen.parse-failure? W216) (shen.parse-failure) (let W217 (shen.in-> W216) (if (shen.hds=? W217 ".") (let W218 (tail W217) (shen.comb W218 shen.skip)) (shen.parse-failure))))) (if (shen.parse-failure? W215) (shen.parse-failure) W215)) W209))) + +(defun shen. (V219) (let W220 (let W221 (shen. V219) (if (shen.parse-failure? W221) (shen.parse-failure) (let W222 (shen.in-> W221) (let W223 (shen. W222) (if (shen.parse-failure? W223) (shen.parse-failure) (let W224 (shen.in-> W223) (shen.comb W224 shen.skip))))))) (if (shen.parse-failure? W220) (let W225 (let W226 ( V219) (if (shen.parse-failure? W226) (shen.parse-failure) (let W227 (shen.in-> W226) (shen.comb W227 shen.skip)))) (if (shen.parse-failure? W225) (shen.parse-failure) W225)) W220))) + +(defun shen. (V228) (let W229 (if (cons? V228) (let W230 (head V228) (let W231 (tail V228) (if (not (= W230 ".")) (shen.comb W231 shen.skip) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W229) (shen.parse-failure) W229))) + +(defun shen. (V232) (let W233 (if (shen.hds=? V232 "<") (let W234 (tail V232) (let W235 ( W234) (if (shen.parse-failure? W235) (shen.parse-failure) (let W236 (shen.<-out W235) (let W237 (shen.in-> W235) (if (let W238 (reverse W236) (and (cons? W238) (= (hd W238) ">"))) (shen.comb W237 shen.skip) (shen.parse-failure))))))) (shen.parse-failure)) (if (shen.parse-failure? W233) (shen.parse-failure) W233))) + +(defun shen.semicolon? (V239) (= V239 (intern ";"))) + +(defun shen. (V240) (let W241 (if (cons? V240) (let W242 (head V240) (let W243 (tail V240) (if (shen.colon-equal? W242) (shen.comb W243 shen.skip) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W241) (shen.parse-failure) W241))) + +(defun shen.colon-equal? (V244) (= (intern ":=") V244)) + +(defun shen. (V245) (let W246 (let W247 (shen. V245) (if (shen.parse-failure? W247) (shen.parse-failure) (let W248 (shen.<-out W247) (let W249 (shen.in-> W247) (let W250 (shen. W249) (if (shen.parse-failure? W250) (shen.parse-failure) (let W251 (shen.<-out W250) (let W252 (shen.in-> W250) (shen.comb W252 (cons W248 W251)))))))))) (if (shen.parse-failure? W246) (let W253 (let W254 (shen. V245) (if (shen.parse-failure? W254) (shen.parse-failure) (let W255 (shen.<-out W254) (let W256 (shen.in-> W254) (shen.comb W256 (cons W255 ())))))) (if (shen.parse-failure? W253) (shen.parse-failure) W253)) W246))) + +(defun shen. (V257) (let W258 (if (cons? V257) (let W259 (head V257) (let W260 (tail V257) (if (shen.syntax-item? W259) (shen.comb W260 W259) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W258) (shen.parse-failure) W258))) + +(defun shen.syntax-item? (V263) (cond ((shen.colon-equal? V263) false) ((shen.semicolon? V263) false) ((atom? V263) true) ((and (cons? V263) (and (= cons (hd V263)) (and (cons? (tl V263)) (and (cons? (tl (tl V263))) (= () (tl (tl (tl V263)))))))) (and (shen.syntax-item? (hd (tl V263))) (shen.syntax-item? (hd (tl (tl V263)))))) (true false))) + +(defun shen. (V264) (let W265 (let W266 (shen. V264) (if (shen.parse-failure? W266) (shen.parse-failure) (let W267 (shen.in-> W266) (if (cons? W267) (let W268 (head W267) (let W269 (tail W267) (if (shen.hds=? W269 where) (let W270 (tail W269) (if (cons? W270) (let W271 (head W270) (let W272 (tail W270) (if (not (shen.semicolon? W268)) (shen.comb W272 (cons where (cons W271 (cons W268 ())))) (shen.parse-failure)))) (shen.parse-failure))) (shen.parse-failure)))) (shen.parse-failure))))) (if (shen.parse-failure? W265) (let W273 (let W274 (shen. V264) (if (shen.parse-failure? W274) (shen.parse-failure) (let W275 (shen.in-> W274) (if (cons? W275) (let W276 (head W275) (let W277 (tail W275) (if (not (shen.semicolon? W276)) (shen.comb W277 W276) (shen.parse-failure)))) (shen.parse-failure))))) (if (shen.parse-failure? W273) (shen.parse-failure) W273)) W265))) + +(defun shen.c-rules->shen (V286 V287 V288) (cond ((= () V288) (cons shen.parse-failure ())) ((cons? V288) (shen.combine-c-code (shen.c-rule->shen V286 (hd V288) V287) (shen.c-rules->shen V286 V287 (tl V288)))) (true (simple-error "implementation error in shen.c-rules->shen +")))) + +(defun shen.parse-failure () (fail)) + +(defun shen.combine-c-code (V289 V290) (cons let (cons Result (cons V289 (cons (cons if (cons (cons shen.parse-failure? (cons Result ())) (cons V290 (cons Result ())))) ()))))) + +(defun shen.c-rule->shen (V297 V298 V299) (cond ((and (cons? V298) (and (cons? (tl V298)) (= () (tl (tl V298))))) (shen.yacc-syntax V297 V299 (hd V298) (hd (tl V298)))) (true (simple-error "implementation error in shen.c-rule->shen +")))) + +(defun shen.yacc-syntax (V308 V309 V310 V311) (cond ((and (= () V310) (and (cons? V311) (and (= where (hd V311)) (and (cons? (tl V311)) (and (cons? (tl (tl V311))) (= () (tl (tl (tl V311))))))))) (cons if (cons (shen.process-yacc-semantics (hd (tl V311))) (cons (shen.yacc-syntax V308 V309 () (hd (tl (tl V311)))) (cons (cons shen.parse-failure ()) ()))))) ((= () V310) (shen.yacc-semantics V308 V309 V311)) ((cons? V310) (if (shen.non-terminal? (hd V310)) (shen.non-terminalcode V308 V309 (hd V310) (tl V310) V311) (if (variable? (hd V310)) (shen.variablecode V308 V309 (hd V310) (tl V310) V311) (if (= _ (hd V310)) (shen.wildcardcode V308 V309 (hd V310) (tl V310) V311) (if (atom? (hd V310)) (shen.terminalcode V308 V309 (hd V310) (tl V310) V311) (if (cons? (hd V310)) (shen.conscode V308 V309 (hd V310) (tl V310) V311) (simple-error "implementation error in shen.yacc-syntax +"))))))) (true (simple-error "implementation error in shen.yacc-syntax +")))) + +(defun shen.non-terminalcode (V312 V313 V314 V315 V316) (let W317 (concat Parse V314) (let W318 (concat Action V314) (let W319 (concat Remainder V314) (cons let (cons W317 (cons (cons V314 (cons V313 ())) (cons (cons if (cons (cons shen.parse-failure? (cons W317 ())) (cons (cons shen.parse-failure ()) (cons (let W320 (cons let (cons W319 (cons (cons shen.in-> (cons W317 ())) (cons (shen.yacc-syntax V312 W319 V315 V316) ())))) (if (or (shen.occurs-check? V314 V316) (shen.occurs-check? W318 V316)) (cons let (cons W318 (cons (cons shen.<-out (cons W317 ())) (cons W320 ())))) W320)) ())))) ())))))))) + +(defun shen.variablecode (V321 V322 V323 V324 V325) (let W326 (gensym Remainder) (cons if (cons (cons cons? (cons V322 ())) (cons (let W327 (cons let (cons W326 (cons (cons tail (cons V322 ())) (cons (shen.yacc-syntax V321 W326 V324 V325) ())))) (if (shen.occurs-check? V323 V325) (cons let (cons V323 (cons (cons head (cons V322 ())) (cons W327 ())))) W327)) (cons (cons shen.parse-failure ()) ())))))) + +(defun shen.wildcardcode (V328 V329 V330 V331 V332) (let W333 (gensym Remainder) (cons if (cons (cons cons? (cons V329 ())) (cons (cons let (cons W333 (cons (cons tail (cons V329 ())) (cons (shen.yacc-syntax V328 W333 V331 V332) ())))) (cons (cons shen.parse-failure ()) ())))))) + +(defun shen.terminalcode (V334 V335 V336 V337 V338) (let W339 (gensym Remainder) (cons if (cons (cons shen.hds=? (cons V335 (cons V336 ()))) (cons (cons let (cons W339 (cons (cons tail (cons V335 ())) (cons (shen.yacc-syntax V334 W339 V337 V338) ())))) (cons (cons shen.parse-failure ()) ())))))) + +(defun shen.hds=? (V347 V348) (cond ((and (cons? V347) (= (hd V347) V348)) true) (true false))) + +(defun shen.conscode (V349 V350 V351 V352 V353) (let W354 (gensym Remainder) (let W355 (gensym Hd) (let W356 (gensym Tl) (cons if (cons (cons shen.ccons? (cons V350 ())) (cons (cons let (cons W355 (cons (cons head (cons V350 ())) (cons W356 (cons (cons tail (cons V350 ())) (cons (shen.yacc-syntax V349 W355 (append (shen.decons V351) (cons ())) (cons shen.processed (cons (shen.yacc-syntax V349 W356 V352 V353) ()))) ())))))) (cons (cons shen.parse-failure ()) ())))))))) + +(defun shen.ccons? (V365) (cond ((and (cons? V365) (cons? (hd V365))) true) (true false))) + +(defun shen.decons (V366) (cond ((and (cons? V366) (and (= cons (hd V366)) (and (cons? (tl V366)) (and (cons? (tl (tl V366))) (= () (tl (tl (tl V366)))))))) (cons (hd (tl V366)) (shen.decons (hd (tl (tl V366)))))) (true V366))) + +(defun shen.comb (V367 V368) (cons V367 (cons V368 ()))) + +(defun shen.yacc-semantics (V373 V374 V375) (cond ((and (cons? V375) (and (= shen.processed (hd V375)) (and (cons? (tl V375)) (= () (tl (tl V375)))))) (hd (tl V375))) (true (let W376 (shen.process-yacc-semantics V375) (let W377 (shen.use-type-info V373 W376) (cons shen.comb (cons V374 (cons W377 ())))))))) + +(defun shen.use-type-info (V381 V382) (cond ((and (cons? V381) (and (= { (hd V381)) (and (cons? (tl V381)) (and (cons? (hd (tl V381))) (and (= list (hd (hd (tl V381)))) (and (cons? (tl (hd (tl V381)))) (and (= () (tl (tl (hd (tl V381))))) (and (cons? (tl (tl V381))) (and (= --> (hd (tl (tl V381)))) (and (cons? (tl (tl (tl V381)))) (and (cons? (hd (tl (tl (tl V381))))) (and (= str (hd (hd (tl (tl (tl V381)))))) (and (cons? (tl (hd (tl (tl (tl V381)))))) (and (cons? (hd (tl (hd (tl (tl (tl V381))))))) (and (= list (hd (hd (tl (hd (tl (tl (tl V381)))))))) (and (cons? (tl (hd (tl (hd (tl (tl (tl V381)))))))) (and (= () (tl (tl (hd (tl (hd (tl (tl (tl V381))))))))) (and (cons? (tl (tl (hd (tl (tl (tl V381))))))) (and (= () (tl (tl (tl (hd (tl (tl (tl V381)))))))) (and (cons? (tl (tl (tl (tl V381))))) (and (= } (hd (tl (tl (tl (tl V381)))))) (and (= () (tl (tl (tl (tl (tl V381)))))) (and (= (hd (tl (hd (tl V381)))) (hd (tl (hd (tl (hd (tl (tl (tl V381))))))))) (shen.monomorphic? (hd (tl (tl (hd (tl (tl (tl V381))))))))))))))))))))))))))))))) (cons type (cons V382 (tl (tl (hd (tl (tl (tl V381))))))))) (true V382))) + +(defun shen.monomorphic? (V385) (cond ((variable? V385) false) ((cons? V385) (and (shen.monomorphic? (hd V385)) (shen.monomorphic? (tl V385)))) (true true))) + +(defun shen.process-yacc-semantics (V386) (cond ((and (cons? V386) (and (= protect (hd V386)) (and (cons? (tl V386)) (and (= () (tl (tl V386))) (shen.non-terminal? (hd (tl V386))))))) (hd (tl V386))) ((cons? V386) (map (lambda Z387 (shen.process-yacc-semantics Z387)) V386)) ((shen.non-terminal? V386) (concat Action V386)) (true V386))) + +(defun shen.<-out (V390) (cond ((and (cons? V390) (and (cons? (tl V390)) (= () (tl (tl V390))))) (hd (tl V390))) (true (hd (tl V390))))) + +(defun shen.in-> (V391) (hd V391)) + +(defun (V392) (cons () (cons V392 ()))) + +(defun (V393) (cons V393 (cons () ()))) + +(defun (V396) (cond ((= () V396) (cons () (cons () ()))) (true (shen.parse-failure)))) + +(defun read-file (V2528) (let W2529 (read-file-as-bytelist V2528) (let W2530 (trap-error (compile (lambda Z2531 (shen. Z2531)) W2529) (lambda Z2532 (shen.reader-error (value shen.*residue*)))) (let W2533 (shen.process-sexprs W2530) W2533)))) + +(defun shen.reader-error (V2534) (simple-error (shen.proc-nl (cn "reader error near here: " (shen.reader-error-message (value *maximum-print-sequence-size*) 0 V2534))))) + +(defun shen.reader-error-message (V2542 V2543 V2544) (cond ((= () V2544) "") ((= V2542 V2543) "") ((cons? V2544) (cn (n->string (hd V2544)) (shen.reader-error-message V2542 (+ V2543 1) (tl V2544)))) (true (shen.f-error shen.reader-error-message)))) + +(defun read-file-as-bytelist (V2545) (let W2546 (open V2545 in) (let W2547 (read-byte W2546) (let W2548 (shen.read-file-as-bytelist-help W2546 W2547 ()) (let W2549 (close W2546) (reverse W2548)))))) + +(defun shen.read-file-as-bytelist-help (V2550 V2551 V2552) (cond ((= -1 V2551) V2552) (true (shen.read-file-as-bytelist-help V2550 (read-byte V2550) (cons V2551 V2552))))) + +(defun input (V2558) (eval-kl (read V2558))) + +(defun input+ (V2559 V2560) (let W2561 (shen.monotype V2559) (let W2562 (read V2560) (if (= false (shen.typecheck W2562 (shen.rectify-type V2559))) (simple-error (cn "type error: " (shen.app W2562 (cn " is not of type " (shen.app V2559 " +" shen.r)) shen.r))) (eval-kl W2562))))) + +(defun shen.monotype (V2563) (cond ((cons? V2563) (map (lambda Z2564 (shen.monotype Z2564)) V2563)) (true (if (variable? V2563) (simple-error (cn "input+ expects a monotype: not " (shen.app V2563 " +" shen.a))) V2563)))) + +(defun lineread (V2565) (shen.read-loop V2565 (shen.my-read-byte V2565) () (lambda Z2566 (shen.return? Z2566)))) + +(defun read (V2577) (hd (shen.read-loop V2577 (shen.my-read-byte V2577) () (lambda Z2578 (shen.whitespace? Z2578))))) + +(defun shen.my-read-byte (V2579) (if (shen.char-stinput? V2579) (string->n (shen.read-unit-string V2579)) (read-byte V2579))) + +(defun shen.read-loop (V2584 V2585 V2586 V2587) (cond ((= 94 V2585) (simple-error "read aborted")) ((= -1 V2585) (if (empty? V2586) (simple-error "error: empty stream") (compile (lambda Z2588 (shen. Z2588)) V2586))) ((= 0 V2585) (shen.read-loop V2584 (shen.my-read-byte V2584) V2586 V2587)) (true (if (V2587 V2585) (let W2589 (shen.try-parse V2586) (if (shen.nothing-doing? W2589) (shen.read-loop V2584 (shen.my-read-byte V2584) (append V2586 (cons V2585 ())) V2587) (do (shen.record-it V2586) W2589))) (shen.read-loop V2584 (shen.my-read-byte V2584) (append V2586 (cons V2585 ())) V2587))))) + +(defun shen.try-parse (V2590) (let W2591 (trap-error (compile (lambda Z2592 (shen. Z2592)) V2590) (lambda Z2593 shen.i-failed!)) (if (shen.nothing-doing? W2591) shen.i-failed! (shen.process-sexprs W2591)))) + +(defun shen.nothing-doing? (V2596) (cond ((= shen.i-failed! V2596) true) ((= () V2596) true) (true false))) + +(defun shen.record-it (V2597) (set shen.*it* (shen.bytes->string V2597))) + +(defun shen.bytes->string (V2598) (cond ((= () V2598) "") ((cons? V2598) (cn (n->string (hd V2598)) (shen.bytes->string (tl V2598)))) (true (shen.f-error shen.bytes->string)))) + +(defun shen.process-sexprs (V2599) (let W2600 (shen.unpackage¯oexpand V2599) (let W2601 (shen.find-arities W2600) (let W2602 (shen.find-types W2600) (map (lambda Z2603 (shen.process-applications Z2603 W2602)) W2600))))) + +(defun shen.find-types (V2604) (cond ((and (cons? V2604) (and (cons? (tl V2604)) (= (hd V2604) (intern ":")))) (cons (hd (tl V2604)) (shen.find-types (tl (tl V2604))))) ((cons? V2604) (append (shen.find-types (hd V2604)) (shen.find-types (tl V2604)))) (true ()))) + +(defun shen.find-arities (V2607) (cond ((and (cons? V2607) (and (= define (hd V2607)) (and (cons? (tl V2607)) (and (cons? (tl (tl V2607))) (= { (hd (tl (tl V2607)))))))) (shen.store-arity (hd (tl V2607)) (shen.find-arity (hd (tl V2607)) 1 (tl (tl (tl V2607)))))) ((and (cons? V2607) (and (= define (hd V2607)) (cons? (tl V2607)))) (shen.store-arity (hd (tl V2607)) (shen.find-arity (hd (tl V2607)) 0 (tl (tl V2607))))) ((cons? V2607) (map (lambda Z2608 (shen.find-arities Z2608)) V2607)) (true shen.skip))) + +(defun shen.store-arity (V2609 V2610) (let W2611 (arity V2609) (if (= W2611 -1) (shen.execute-store-arity V2609 V2610) (if (= W2611 V2610) shen.skip (if (shen.sysfunc? V2609) (simple-error (shen.app V2609 " is a system function +" shen.a)) (do (pr (cn "changing the arity of " (shen.app V2609 " may cause errors +" shen.a)) (stoutput)) (shen.execute-store-arity V2609 V2610))))))) + +(defun shen.execute-store-arity (V2612 V2613) (cond ((= 0 V2613) (put V2612 arity 0 (value *property-vector*))) (true (do (put V2612 arity V2613 (value *property-vector*)) (shen.update-lambdatable V2612 V2613))))) + +(defun shen.update-lambdatable (V2614 V2615) (let W2616 (eval-kl (shen.lambda-function (cons V2614 ()) V2615)) (let W2617 (shen.set-lambda-form-entry (cons V2614 W2616)) V2615))) + +(defun shen.lambda-function (V2620 V2621) (cond ((= 0 V2621) shen.skip) ((= 1 V2621) (let W2622 (gensym Y) (cons lambda (cons W2622 (cons (append V2620 (cons W2622 ())) ()))))) (true (let W2623 (gensym Y) (cons lambda (cons W2623 (cons (shen.lambda-function (append V2620 (cons W2623 ())) (- V2621 1)) ()))))))) + +(defun shen.assoc-> (V2633 V2634 V2635) (cond ((= () V2635) (cons (cons V2633 V2634) ())) ((and (cons? V2635) (and (cons? (hd V2635)) (= V2633 (hd (hd V2635))))) (cons (cons (hd (hd V2635)) V2634) (tl V2635))) ((cons? V2635) (cons (hd V2635) (shen.assoc-> V2633 V2634 (tl V2635)))) (true (simple-error "implementation error in shen.assoc->")))) + +(defun shen.find-arity (V2650 V2651 V2652) (cond ((and (= 0 V2651) (and (cons? V2652) (= (hd V2652) ->))) 0) ((and (= 0 V2651) (and (cons? V2652) (= (hd V2652) <-))) 0) ((and (= 0 V2651) (cons? V2652)) (+ 1 (shen.find-arity V2650 0 (tl V2652)))) ((and (= 1 V2651) (and (cons? V2652) (= } (hd V2652)))) (shen.find-arity V2650 0 (tl V2652))) ((and (= 1 V2651) (cons? V2652)) (shen.find-arity V2650 1 (tl V2652))) ((= 1 V2651) (simple-error (cn "syntax error in " (shen.app V2650 " definition: missing } +" shen.a)))) (true (simple-error (cn "syntax error in " (shen.app V2650 " definition: missing -> or <- +" shen.a)))))) + +(defun shen. (V2653) (let W2654 (let W2655 (shen. V2653) (if (shen.parse-failure? W2655) (shen.parse-failure) (let W2656 (shen.in-> W2655) (let W2657 (shen. W2656) (if (shen.parse-failure? W2657) (shen.parse-failure) (let W2658 (shen.<-out W2657) (let W2659 (shen.in-> W2657) (let W2660 (shen. W2659) (if (shen.parse-failure? W2660) (shen.parse-failure) (let W2661 (shen.in-> W2660) (let W2662 (shen. W2661) (if (shen.parse-failure? W2662) (shen.parse-failure) (let W2663 (shen.<-out W2662) (let W2664 (shen.in-> W2662) (shen.comb W2664 (cons (shen.cons-form W2658) W2663)))))))))))))))) (if (shen.parse-failure? W2654) (let W2665 (let W2666 (shen. V2653) (if (shen.parse-failure? W2666) (shen.parse-failure) (let W2667 (shen.in-> W2666) (let W2668 (shen. W2667) (if (shen.parse-failure? W2668) (shen.parse-failure) (let W2669 (shen.<-out W2668) (let W2670 (shen.in-> W2668) (let W2671 (shen. W2670) (if (shen.parse-failure? W2671) (shen.parse-failure) (let W2672 (shen.in-> W2671) (let W2673 (shen. W2672) (if (shen.parse-failure? W2673) (shen.parse-failure) (let W2674 (shen.<-out W2673) (let W2675 (shen.in-> W2673) (shen.comb W2675 (shen.add-sexpr W2669 W2674)))))))))))))))) (if (shen.parse-failure? W2665) (let W2676 (let W2677 (shen. V2653) (if (shen.parse-failure? W2677) (shen.parse-failure) (let W2678 (shen.in-> W2677) (let W2679 (shen. W2678) (if (shen.parse-failure? W2679) (shen.parse-failure) (let W2680 (shen.<-out W2679) (let W2681 (shen.in-> W2679) (shen.comb W2681 (cons { W2680))))))))) (if (shen.parse-failure? W2676) (let W2682 (let W2683 (shen. V2653) (if (shen.parse-failure? W2683) (shen.parse-failure) (let W2684 (shen.in-> W2683) (let W2685 (shen. W2684) (if (shen.parse-failure? W2685) (shen.parse-failure) (let W2686 (shen.<-out W2685) (let W2687 (shen.in-> W2685) (shen.comb W2687 (cons } W2686))))))))) (if (shen.parse-failure? W2682) (let W2688 (let W2689 (shen. V2653) (if (shen.parse-failure? W2689) (shen.parse-failure) (let W2690 (shen.in-> W2689) (let W2691 (shen. W2690) (if (shen.parse-failure? W2691) (shen.parse-failure) (let W2692 (shen.<-out W2691) (let W2693 (shen.in-> W2691) (shen.comb W2693 (cons bar! W2692))))))))) (if (shen.parse-failure? W2688) (let W2694 (let W2695 (shen. V2653) (if (shen.parse-failure? W2695) (shen.parse-failure) (let W2696 (shen.in-> W2695) (let W2697 (shen. W2696) (if (shen.parse-failure? W2697) (shen.parse-failure) (let W2698 (shen.<-out W2697) (let W2699 (shen.in-> W2697) (shen.comb W2699 (cons (intern ";") W2698))))))))) (if (shen.parse-failure? W2694) (let W2700 (let W2701 (shen. V2653) (if (shen.parse-failure? W2701) (shen.parse-failure) (let W2702 (shen.in-> W2701) (let W2703 (shen. W2702) (if (shen.parse-failure? W2703) (shen.parse-failure) (let W2704 (shen.in-> W2703) (let W2705 (shen. W2704) (if (shen.parse-failure? W2705) (shen.parse-failure) (let W2706 (shen.<-out W2705) (let W2707 (shen.in-> W2705) (shen.comb W2707 (cons (intern ":=") W2706)))))))))))) (if (shen.parse-failure? W2700) (let W2708 (let W2709 (shen. V2653) (if (shen.parse-failure? W2709) (shen.parse-failure) (let W2710 (shen.in-> W2709) (let W2711 (shen. W2710) (if (shen.parse-failure? W2711) (shen.parse-failure) (let W2712 (shen.<-out W2711) (let W2713 (shen.in-> W2711) (shen.comb W2713 (cons (intern ":") W2712))))))))) (if (shen.parse-failure? W2708) (let W2714 (let W2715 (shen. V2653) (if (shen.parse-failure? W2715) (shen.parse-failure) (let W2716 (shen.in-> W2715) (let W2717 (shen. W2716) (if (shen.parse-failure? W2717) (shen.parse-failure) (let W2718 (shen.<-out W2717) (let W2719 (shen.in-> W2717) (shen.comb W2719 (cons (intern ",") W2718))))))))) (if (shen.parse-failure? W2714) (let W2720 (let W2721 (shen. V2653) (if (shen.parse-failure? W2721) (shen.parse-failure) (let W2722 (shen.in-> W2721) (let W2723 (shen. W2722) (if (shen.parse-failure? W2723) (shen.parse-failure) (let W2724 (shen.<-out W2723) (let W2725 (shen.in-> W2723) (shen.comb W2725 W2724)))))))) (if (shen.parse-failure? W2720) (let W2726 (let W2727 (shen. V2653) (if (shen.parse-failure? W2727) (shen.parse-failure) (let W2728 (shen.<-out W2727) (let W2729 (shen.in-> W2727) (let W2730 (shen. W2729) (if (shen.parse-failure? W2730) (shen.parse-failure) (let W2731 (shen.<-out W2730) (let W2732 (shen.in-> W2730) (shen.comb W2732 (cons W2728 W2731)))))))))) (if (shen.parse-failure? W2726) (let W2733 (let W2734 (shen. V2653) (if (shen.parse-failure? W2734) (shen.parse-failure) (let W2735 (shen.in-> W2734) (let W2736 (shen. W2735) (if (shen.parse-failure? W2736) (shen.parse-failure) (let W2737 (shen.<-out W2736) (let W2738 (shen.in-> W2736) (shen.comb W2738 W2737)))))))) (if (shen.parse-failure? W2733) (let W2739 (let W2740 ( V2653) (if (shen.parse-failure? W2740) (shen.parse-failure) (let W2741 (shen.in-> W2740) (shen.comb W2741 ())))) (if (shen.parse-failure? W2739) (shen.parse-failure) W2739)) W2733)) W2726)) W2720)) W2714)) W2708)) W2700)) W2694)) W2688)) W2682)) W2676)) W2665)) W2654))) + +(defun shen.add-sexpr (V2742 V2743) (cond ((and (cons? V2742) (and (= $ (hd V2742)) (and (cons? (tl V2742)) (= () (tl (tl V2742)))))) (append (explode (hd (tl V2742))) V2743)) (true (cons V2742 V2743)))) + +(defun shen. (V2744) (let W2745 (if (shen.hds=? V2744 91) (let W2746 (tail V2744) (shen.comb W2746 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2745) (shen.parse-failure) W2745))) + +(defun shen. (V2747) (let W2748 (if (shen.hds=? V2747 93) (let W2749 (tail V2747) (shen.comb W2749 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2748) (shen.parse-failure) W2748))) + +(defun shen. (V2750) (let W2751 (let W2752 (shen. V2750) (if (shen.parse-failure? W2752) (shen.parse-failure) (let W2753 (shen.<-out W2752) (let W2754 (shen.in-> W2752) (shen.comb W2754 W2753))))) (if (shen.parse-failure? W2751) (shen.parse-failure) W2751))) + +(defun shen. (V2755) (let W2756 (let W2757 (shen. V2755) (if (shen.parse-failure? W2757) (shen.parse-failure) (let W2758 (shen.<-out W2757) (let W2759 (shen.in-> W2757) (shen.comb W2759 W2758))))) (if (shen.parse-failure? W2756) (shen.parse-failure) W2756))) + +(defun shen.cons-form (V2761) (cond ((= () V2761) ()) ((and (cons? V2761) (and (cons? (tl V2761)) (and (cons? (tl (tl V2761))) (and (= () (tl (tl (tl V2761)))) (= (hd (tl V2761)) bar!))))) (cons cons (cons (hd V2761) (tl (tl V2761))))) ((and (cons? V2761) (and (cons? (tl V2761)) (and (cons? (tl (tl V2761))) (and (cons? (tl (tl (tl V2761)))) (= (hd (tl V2761)) bar!))))) (simple-error "misapplication of | +")) ((cons? V2761) (cons cons (cons (hd V2761) (cons (shen.cons-form (tl V2761)) ())))) (true (shen.f-error shen.cons-form)))) + +(defun shen. (V2762) (let W2763 (if (shen.hds=? V2762 40) (let W2764 (tail V2762) (shen.comb W2764 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2763) (shen.parse-failure) W2763))) + +(defun shen. (V2765) (let W2766 (if (shen.hds=? V2765 41) (let W2767 (tail V2765) (shen.comb W2767 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2766) (shen.parse-failure) W2766))) + +(defun shen. (V2768) (let W2769 (if (shen.hds=? V2768 123) (let W2770 (tail V2768) (shen.comb W2770 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2769) (shen.parse-failure) W2769))) + +(defun shen. (V2771) (let W2772 (if (shen.hds=? V2771 125) (let W2773 (tail V2771) (shen.comb W2773 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2772) (shen.parse-failure) W2772))) + +(defun shen. (V2774) (let W2775 (if (shen.hds=? V2774 124) (let W2776 (tail V2774) (shen.comb W2776 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2775) (shen.parse-failure) W2775))) + +(defun shen. (V2777) (let W2778 (if (shen.hds=? V2777 59) (let W2779 (tail V2777) (shen.comb W2779 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2778) (shen.parse-failure) W2778))) + +(defun shen. (V2780) (let W2781 (if (shen.hds=? V2780 58) (let W2782 (tail V2780) (shen.comb W2782 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2781) (shen.parse-failure) W2781))) + +(defun shen. (V2783) (let W2784 (if (shen.hds=? V2783 44) (let W2785 (tail V2783) (shen.comb W2785 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2784) (shen.parse-failure) W2784))) + +(defun shen. (V2786) (let W2787 (if (shen.hds=? V2786 61) (let W2788 (tail V2786) (shen.comb W2788 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2787) (shen.parse-failure) W2787))) + +(defun shen. (V2789) (let W2790 (let W2791 (shen. V2789) (if (shen.parse-failure? W2791) (shen.parse-failure) (let W2792 (shen.in-> W2791) (shen.comb W2792 shen.skip)))) (if (shen.parse-failure? W2790) (let W2793 (let W2794 (shen. V2789) (if (shen.parse-failure? W2794) (shen.parse-failure) (let W2795 (shen.in-> W2794) (shen.comb W2795 shen.skip)))) (if (shen.parse-failure? W2793) (shen.parse-failure) W2793)) W2790))) + +(defun shen. (V2796) (let W2797 (let W2798 (shen. V2796) (if (shen.parse-failure? W2798) (shen.parse-failure) (let W2799 (shen.in-> W2798) (let W2800 (shen. W2799) (if (shen.parse-failure? W2800) (shen.parse-failure) (let W2801 (shen.in-> W2800) (let W2802 (shen. W2801) (if (shen.parse-failure? W2802) (shen.parse-failure) (let W2803 (shen.in-> W2802) (let W2804 (shen. W2803) (if (shen.parse-failure? W2804) (shen.parse-failure) (let W2805 (shen.in-> W2804) (shen.comb W2805 shen.skip))))))))))))) (if (shen.parse-failure? W2797) (shen.parse-failure) W2797))) + +(defun shen. (V2806) (let W2807 (if (shen.hds=? V2806 92) (let W2808 (tail V2806) (shen.comb W2808 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2807) (shen.parse-failure) W2807))) + +(defun shen. (V2809) (let W2810 (let W2811 (shen. V2809) (if (shen.parse-failure? W2811) (shen.parse-failure) (let W2812 (shen.in-> W2811) (let W2813 (shen. W2812) (if (shen.parse-failure? W2813) (shen.parse-failure) (let W2814 (shen.in-> W2813) (shen.comb W2814 shen.skip))))))) (if (shen.parse-failure? W2810) (let W2815 (let W2816 ( V2809) (if (shen.parse-failure? W2816) (shen.parse-failure) (let W2817 (shen.in-> W2816) (shen.comb W2817 shen.skip)))) (if (shen.parse-failure? W2815) (shen.parse-failure) W2815)) W2810))) + +(defun shen. (V2818) (let W2819 (if (cons? V2818) (let W2820 (head V2818) (let W2821 (tail V2818) (if (not (shen.return? W2820)) (shen.comb W2821 shen.skip) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W2819) (shen.parse-failure) W2819))) + +(defun shen. (V2822) (let W2823 (let W2824 (shen. V2822) (if (shen.parse-failure? W2824) (shen.parse-failure) (let W2825 (shen.in-> W2824) (let W2826 (shen. W2825) (if (shen.parse-failure? W2826) (shen.parse-failure) (let W2827 (shen.in-> W2826) (shen.comb W2827 shen.skip))))))) (if (shen.parse-failure? W2823) (let W2828 (let W2829 (shen. V2822) (if (shen.parse-failure? W2829) (shen.parse-failure) (let W2830 (shen.in-> W2829) (shen.comb W2830 shen.skip)))) (if (shen.parse-failure? W2828) (shen.parse-failure) W2828)) W2823))) + +(defun shen. (V2831) (let W2832 (if (cons? V2831) (let W2833 (head V2831) (let W2834 (tail V2831) (if (shen.return? W2833) (shen.comb W2834 shen.skip) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W2832) (shen.parse-failure) W2832))) + +(defun shen.return? (V2835) (element? V2835 (cons 9 (cons 10 (cons 13 ()))))) + +(defun shen. (V2836) (let W2837 (let W2838 (shen. V2836) (if (shen.parse-failure? W2838) (shen.parse-failure) (let W2839 (shen.in-> W2838) (let W2840 (shen. W2839) (if (shen.parse-failure? W2840) (shen.parse-failure) (let W2841 (shen.in-> W2840) (let W2842 (shen. W2841) (if (shen.parse-failure? W2842) (shen.parse-failure) (let W2843 (shen.in-> W2842) (shen.comb W2843 shen.skip)))))))))) (if (shen.parse-failure? W2837) (shen.parse-failure) W2837))) + +(defun shen. (V2844) (let W2845 (if (shen.hds=? V2844 42) (let W2846 (tail V2844) (shen.comb W2846 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2845) (shen.parse-failure) W2845))) + +(defun shen. (V2847) (let W2848 (let W2849 (shen. V2847) (if (shen.parse-failure? W2849) (shen.parse-failure) (let W2850 (shen.in-> W2849) (let W2851 (shen. W2850) (if (shen.parse-failure? W2851) (shen.parse-failure) (let W2852 (shen.in-> W2851) (shen.comb W2852 shen.skip))))))) (if (shen.parse-failure? W2848) (let W2853 (let W2854 (shen. V2847) (if (shen.parse-failure? W2854) (shen.parse-failure) (let W2855 (shen.in-> W2854) (let W2856 (shen. W2855) (if (shen.parse-failure? W2856) (shen.parse-failure) (let W2857 (shen.in-> W2856) (shen.comb W2857 shen.skip))))))) (if (shen.parse-failure? W2853) (let W2858 (if (cons? V2847) (let W2859 (tail V2847) (let W2860 (shen. W2859) (if (shen.parse-failure? W2860) (shen.parse-failure) (let W2861 (shen.in-> W2860) (shen.comb W2861 shen.skip))))) (shen.parse-failure)) (if (shen.parse-failure? W2858) (shen.parse-failure) W2858)) W2853)) W2848))) + +(defun shen. (V2862) (let W2863 (let W2864 (shen. V2862) (if (shen.parse-failure? W2864) (shen.parse-failure) (let W2865 (shen.<-out W2864) (let W2866 (shen.in-> W2864) (shen.comb W2866 W2865))))) (if (shen.parse-failure? W2863) (let W2867 (let W2868 (shen. V2862) (if (shen.parse-failure? W2868) (shen.parse-failure) (let W2869 (shen.<-out W2868) (let W2870 (shen.in-> W2868) (shen.comb W2870 W2869))))) (if (shen.parse-failure? W2867) (let W2871 (let W2872 (shen. V2862) (if (shen.parse-failure? W2872) (shen.parse-failure) (let W2873 (shen.<-out W2872) (let W2874 (shen.in-> W2872) (shen.comb W2874 (if (= W2873 "<>") (cons vector (cons 0 ())) (intern W2873))))))) (if (shen.parse-failure? W2871) (shen.parse-failure) W2871)) W2867)) W2863))) + +(defun shen. (V2875) (let W2876 (let W2877 (shen. V2875) (if (shen.parse-failure? W2877) (shen.parse-failure) (let W2878 (shen.<-out W2877) (let W2879 (shen.in-> W2877) (let W2880 (shen. W2879) (if (shen.parse-failure? W2880) (shen.parse-failure) (let W2881 (shen.<-out W2880) (let W2882 (shen.in-> W2880) (shen.comb W2882 (cn W2878 W2881)))))))))) (if (shen.parse-failure? W2876) (shen.parse-failure) W2876))) + +(defun shen. (V2883) (let W2884 (if (cons? V2883) (let W2885 (head V2883) (let W2886 (tail V2883) (if (shen.alpha? W2885) (shen.comb W2886 (n->string W2885)) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W2884) (shen.parse-failure) W2884))) + +(defun shen.alpha? (V2887) (or (shen.lowercase? V2887) (or (shen.uppercase? V2887) (shen.misc? V2887)))) + +(defun shen.lowercase? (V2888) (and (>= V2888 97) (<= V2888 122))) + +(defun shen.uppercase? (V2889) (and (>= V2889 65) (<= V2889 90))) + +(defun shen.misc? (V2890) (element? V2890 (cons 61 (cons 45 (cons 42 (cons 47 (cons 43 (cons 95 (cons 63 (cons 36 (cons 33 (cons 64 (cons 126 (cons 46 (cons 62 (cons 60 (cons 38 (cons 37 (cons 39 (cons 35 (cons 96 ()))))))))))))))))))))) + +(defun shen. (V2891) (let W2892 (let W2893 (shen. V2891) (if (shen.parse-failure? W2893) (shen.parse-failure) (let W2894 (shen.<-out W2893) (let W2895 (shen.in-> W2893) (let W2896 (shen. W2895) (if (shen.parse-failure? W2896) (shen.parse-failure) (let W2897 (shen.<-out W2896) (let W2898 (shen.in-> W2896) (shen.comb W2898 (cn W2894 W2897)))))))))) (if (shen.parse-failure? W2892) (let W2899 (let W2900 ( V2891) (if (shen.parse-failure? W2900) (shen.parse-failure) (let W2901 (shen.in-> W2900) (shen.comb W2901 "")))) (if (shen.parse-failure? W2899) (shen.parse-failure) W2899)) W2892))) + +(defun shen. (V2902) (let W2903 (let W2904 (shen. V2902) (if (shen.parse-failure? W2904) (shen.parse-failure) (let W2905 (shen.<-out W2904) (let W2906 (shen.in-> W2904) (shen.comb W2906 W2905))))) (if (shen.parse-failure? W2903) (let W2907 (let W2908 (shen. V2902) (if (shen.parse-failure? W2908) (shen.parse-failure) (let W2909 (shen.<-out W2908) (let W2910 (shen.in-> W2908) (shen.comb W2910 W2909))))) (if (shen.parse-failure? W2907) (shen.parse-failure) W2907)) W2903))) + +(defun shen. (V2911) (let W2912 (if (cons? V2911) (let W2913 (head V2911) (let W2914 (tail V2911) (if (shen.digit? W2913) (shen.comb W2914 (n->string W2913)) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W2912) (shen.parse-failure) W2912))) + +(defun shen.digit? (V2915) (and (>= V2915 48) (<= V2915 57))) + +(defun shen. (V2916) (let W2917 (let W2918 (shen. V2916) (if (shen.parse-failure? W2918) (shen.parse-failure) (let W2919 (shen.in-> W2918) (let W2920 (shen. W2919) (if (shen.parse-failure? W2920) (shen.parse-failure) (let W2921 (shen.<-out W2920) (let W2922 (shen.in-> W2920) (let W2923 (shen. W2922) (if (shen.parse-failure? W2923) (shen.parse-failure) (let W2924 (shen.in-> W2923) (shen.comb W2924 W2921))))))))))) (if (shen.parse-failure? W2917) (shen.parse-failure) W2917))) + +(defun shen. (V2925) (let W2926 (if (shen.hds=? V2925 34) (let W2927 (tail V2925) (shen.comb W2927 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2926) (shen.parse-failure) W2926))) + +(defun shen. (V2928) (let W2929 (let W2930 (shen. V2928) (if (shen.parse-failure? W2930) (shen.parse-failure) (let W2931 (shen.<-out W2930) (let W2932 (shen.in-> W2930) (let W2933 (shen. W2932) (if (shen.parse-failure? W2933) (shen.parse-failure) (let W2934 (shen.<-out W2933) (let W2935 (shen.in-> W2933) (shen.comb W2935 (cn W2931 W2934)))))))))) (if (shen.parse-failure? W2929) (let W2936 (let W2937 ( V2928) (if (shen.parse-failure? W2937) (shen.parse-failure) (let W2938 (shen.in-> W2937) (shen.comb W2938 "")))) (if (shen.parse-failure? W2936) (shen.parse-failure) W2936)) W2929))) + +(defun shen. (V2939) (let W2940 (let W2941 (shen. V2939) (if (shen.parse-failure? W2941) (shen.parse-failure) (let W2942 (shen.<-out W2941) (let W2943 (shen.in-> W2941) (shen.comb W2943 W2942))))) (if (shen.parse-failure? W2940) (let W2944 (let W2945 (shen. V2939) (if (shen.parse-failure? W2945) (shen.parse-failure) (let W2946 (shen.<-out W2945) (let W2947 (shen.in-> W2945) (shen.comb W2947 W2946))))) (if (shen.parse-failure? W2944) (shen.parse-failure) W2944)) W2940))) + +(defun shen. (V2948) (let W2949 (let W2950 (shen. V2948) (if (shen.parse-failure? W2950) (shen.parse-failure) (let W2951 (shen.in-> W2950) (let W2952 (shen. W2951) (if (shen.parse-failure? W2952) (shen.parse-failure) (let W2953 (shen.in-> W2952) (let W2954 (shen. W2953) (if (shen.parse-failure? W2954) (shen.parse-failure) (let W2955 (shen.<-out W2954) (let W2956 (shen.in-> W2954) (let W2957 (shen. W2956) (if (shen.parse-failure? W2957) (shen.parse-failure) (let W2958 (shen.in-> W2957) (shen.comb W2958 (n->string W2955))))))))))))))) (if (shen.parse-failure? W2949) (shen.parse-failure) W2949))) + +(defun shen. (V2959) (let W2960 (if (cons? V2959) (let W2961 (head V2959) (let W2962 (tail V2959) (if (not (= W2961 34)) (shen.comb W2962 (n->string W2961)) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W2960) (shen.parse-failure) W2960))) + +(defun shen. (V2963) (let W2964 (if (shen.hds=? V2963 99) (let W2965 (tail V2963) (shen.comb W2965 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2964) (shen.parse-failure) W2964))) + +(defun shen. (V2966) (let W2967 (if (shen.hds=? V2966 35) (let W2968 (tail V2966) (shen.comb W2968 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2967) (shen.parse-failure) W2967))) + +(defun shen. (V2969) (let W2970 (let W2971 (shen. V2969) (if (shen.parse-failure? W2971) (shen.parse-failure) (let W2972 (shen.in-> W2971) (let W2973 (shen. W2972) (if (shen.parse-failure? W2973) (shen.parse-failure) (let W2974 (shen.<-out W2973) (let W2975 (shen.in-> W2973) (shen.comb W2975 (- 0 W2974))))))))) (if (shen.parse-failure? W2970) (let W2976 (let W2977 (shen. V2969) (if (shen.parse-failure? W2977) (shen.parse-failure) (let W2978 (shen.in-> W2977) (let W2979 (shen. W2978) (if (shen.parse-failure? W2979) (shen.parse-failure) (let W2980 (shen.<-out W2979) (let W2981 (shen.in-> W2979) (shen.comb W2981 W2980)))))))) (if (shen.parse-failure? W2976) (let W2982 (let W2983 (shen. V2969) (if (shen.parse-failure? W2983) (shen.parse-failure) (let W2984 (shen.<-out W2983) (let W2985 (shen.in-> W2983) (shen.comb W2985 W2984))))) (if (shen.parse-failure? W2982) (let W2986 (let W2987 (shen. V2969) (if (shen.parse-failure? W2987) (shen.parse-failure) (let W2988 (shen.<-out W2987) (let W2989 (shen.in-> W2987) (shen.comb W2989 W2988))))) (if (shen.parse-failure? W2986) (let W2990 (let W2991 (shen. V2969) (if (shen.parse-failure? W2991) (shen.parse-failure) (let W2992 (shen.<-out W2991) (let W2993 (shen.in-> W2991) (shen.comb W2993 W2992))))) (if (shen.parse-failure? W2990) (shen.parse-failure) W2990)) W2986)) W2982)) W2976)) W2970))) + +(defun shen. (V2994) (let W2995 (if (shen.hds=? V2994 45) (let W2996 (tail V2994) (shen.comb W2996 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2995) (shen.parse-failure) W2995))) + +(defun shen. (V2997) (let W2998 (if (shen.hds=? V2997 43) (let W2999 (tail V2997) (shen.comb W2999 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2998) (shen.parse-failure) W2998))) + +(defun shen. (V3000) (let W3001 (let W3002 (shen. V3000) (if (shen.parse-failure? W3002) (shen.parse-failure) (let W3003 (shen.<-out W3002) (let W3004 (shen.in-> W3002) (shen.comb W3004 (shen.compute-integer W3003)))))) (if (shen.parse-failure? W3001) (shen.parse-failure) W3001))) + +(defun shen. (V3005) (let W3006 (let W3007 (shen. V3005) (if (shen.parse-failure? W3007) (shen.parse-failure) (let W3008 (shen.<-out W3007) (let W3009 (shen.in-> W3007) (let W3010 (shen. W3009) (if (shen.parse-failure? W3010) (shen.parse-failure) (let W3011 (shen.<-out W3010) (let W3012 (shen.in-> W3010) (shen.comb W3012 (cons W3008 W3011)))))))))) (if (shen.parse-failure? W3006) (let W3013 (let W3014 (shen. V3005) (if (shen.parse-failure? W3014) (shen.parse-failure) (let W3015 (shen.<-out W3014) (let W3016 (shen.in-> W3014) (shen.comb W3016 (cons W3015 ())))))) (if (shen.parse-failure? W3013) (shen.parse-failure) W3013)) W3006))) + +(defun shen. (V3017) (let W3018 (if (cons? V3017) (let W3019 (head V3017) (let W3020 (tail V3017) (if (shen.digit? W3019) (shen.comb W3020 (shen.byte->digit W3019)) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W3018) (shen.parse-failure) W3018))) + +(defun shen.byte->digit (V3021) (- V3021 48)) + +(defun shen.compute-integer (V3022) (shen.compute-integer-h (reverse V3022) 0)) + +(defun shen.compute-integer-h (V3025 V3026) (cond ((= () V3025) 0) ((cons? V3025) (+ (* (shen.expt 10 V3026) (hd V3025)) (shen.compute-integer-h (tl V3025) (+ V3026 1)))) (true (shen.f-error shen.compute-integer-h)))) + +(defun shen.expt (V3029 V3030) (cond ((= 0 V3030) 1) ((> V3030 0) (* V3029 (shen.expt V3029 (- V3030 1)))) (true (/ (shen.expt V3029 (+ V3030 1)) V3029)))) + +(defun shen. (V3031) (let W3032 (let W3033 (shen. V3031) (if (shen.parse-failure? W3033) (shen.parse-failure) (let W3034 (shen.<-out W3033) (let W3035 (shen.in-> W3033) (let W3036 (shen. W3035) (if (shen.parse-failure? W3036) (shen.parse-failure) (let W3037 (shen.in-> W3036) (let W3038 (shen. W3037) (if (shen.parse-failure? W3038) (shen.parse-failure) (let W3039 (shen.<-out W3038) (let W3040 (shen.in-> W3038) (shen.comb W3040 (+ W3034 W3039))))))))))))) (if (shen.parse-failure? W3032) (let W3041 (let W3042 (shen. V3031) (if (shen.parse-failure? W3042) (shen.parse-failure) (let W3043 (shen.in-> W3042) (let W3044 (shen. W3043) (if (shen.parse-failure? W3044) (shen.parse-failure) (let W3045 (shen.<-out W3044) (let W3046 (shen.in-> W3044) (shen.comb W3046 W3045)))))))) (if (shen.parse-failure? W3041) (shen.parse-failure) W3041)) W3032))) + +(defun shen. (V3047) (let W3048 (if (shen.hds=? V3047 46) (let W3049 (tail V3047) (shen.comb W3049 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W3048) (shen.parse-failure) W3048))) + +(defun shen. (V3050) (let W3051 (let W3052 (shen. V3050) (if (shen.parse-failure? W3052) (shen.parse-failure) (let W3053 (shen.<-out W3052) (let W3054 (shen.in-> W3052) (shen.comb W3054 (shen.compute-fraction W3053)))))) (if (shen.parse-failure? W3051) (shen.parse-failure) W3051))) + +(defun shen.compute-fraction (V3055) (shen.compute-fraction-h V3055 -1)) + +(defun shen.compute-fraction-h (V3058 V3059) (cond ((= () V3058) 0) ((cons? V3058) (+ (* (shen.expt 10 V3059) (hd V3058)) (shen.compute-fraction-h (tl V3058) (- V3059 1)))) (true (shen.f-error shen.compute-fraction-h)))) + +(defun shen. (V3060) (let W3061 (let W3062 (shen. V3060) (if (shen.parse-failure? W3062) (shen.parse-failure) (let W3063 (shen.<-out W3062) (let W3064 (shen.in-> W3062) (let W3065 (shen. W3064) (if (shen.parse-failure? W3065) (shen.parse-failure) (let W3066 (shen.in-> W3065) (let W3067 (shen. W3066) (if (shen.parse-failure? W3067) (shen.parse-failure) (let W3068 (shen.<-out W3067) (let W3069 (shen.in-> W3067) (shen.comb W3069 (shen.compute-E W3063 W3068))))))))))))) (if (shen.parse-failure? W3061) (let W3070 (let W3071 (shen. V3060) (if (shen.parse-failure? W3071) (shen.parse-failure) (let W3072 (shen.<-out W3071) (let W3073 (shen.in-> W3071) (let W3074 (shen. W3073) (if (shen.parse-failure? W3074) (shen.parse-failure) (let W3075 (shen.in-> W3074) (let W3076 (shen. W3075) (if (shen.parse-failure? W3076) (shen.parse-failure) (let W3077 (shen.<-out W3076) (let W3078 (shen.in-> W3076) (shen.comb W3078 (shen.compute-E W3072 W3077))))))))))))) (if (shen.parse-failure? W3070) (shen.parse-failure) W3070)) W3061))) + +(defun shen. (V3079) (let W3080 (let W3081 (shen. V3079) (if (shen.parse-failure? W3081) (shen.parse-failure) (let W3082 (shen.in-> W3081) (let W3083 (shen. W3082) (if (shen.parse-failure? W3083) (shen.parse-failure) (let W3084 (shen.<-out W3083) (let W3085 (shen.in-> W3083) (shen.comb W3085 W3084)))))))) (if (shen.parse-failure? W3080) (let W3086 (let W3087 (shen. V3079) (if (shen.parse-failure? W3087) (shen.parse-failure) (let W3088 (shen.in-> W3087) (let W3089 (shen. W3088) (if (shen.parse-failure? W3089) (shen.parse-failure) (let W3090 (shen.<-out W3089) (let W3091 (shen.in-> W3089) (shen.comb W3091 (- 0 W3090))))))))) (if (shen.parse-failure? W3086) (let W3092 (let W3093 (shen. V3079) (if (shen.parse-failure? W3093) (shen.parse-failure) (let W3094 (shen.<-out W3093) (let W3095 (shen.in-> W3093) (shen.comb W3095 W3094))))) (if (shen.parse-failure? W3092) (shen.parse-failure) W3092)) W3086)) W3080))) + +(defun shen. (V3096) (let W3097 (if (shen.hds=? V3096 101) (let W3098 (tail V3096) (shen.comb W3098 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W3097) (shen.parse-failure) W3097))) + +(defun shen.compute-E (V3099 V3100) (* V3099 (shen.expt 10 V3100))) + +(defun shen. (V3101) (let W3102 (let W3103 (shen. V3101) (if (shen.parse-failure? W3103) (shen.parse-failure) (let W3104 (shen.in-> W3103) (let W3105 (shen. W3104) (if (shen.parse-failure? W3105) (shen.parse-failure) (let W3106 (shen.in-> W3105) (shen.comb W3106 shen.skip))))))) (if (shen.parse-failure? W3102) (let W3107 (let W3108 (shen. V3101) (if (shen.parse-failure? W3108) (shen.parse-failure) (let W3109 (shen.in-> W3108) (shen.comb W3109 shen.skip)))) (if (shen.parse-failure? W3107) (shen.parse-failure) W3107)) W3102))) + +(defun shen. (V3110) (let W3111 (if (cons? V3110) (let W3112 (head V3110) (let W3113 (tail V3110) (if (shen.whitespace? W3112) (shen.comb W3113 shen.skip) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W3111) (shen.parse-failure) W3111))) + +(defun shen.whitespace? (V3116) (cond ((= 32 V3116) true) ((= 13 V3116) true) ((= 10 V3116) true) ((= 9 V3116) true) (true false))) + +(defun shen.unpackage¯oexpand (V3117) (cond ((= () V3117) ()) ((and (cons? V3117) (shen.packaged? (hd V3117))) (shen.unpackage¯oexpand (append (shen.unpackage (hd V3117)) (tl V3117)))) ((cons? V3117) (let W3118 (macroexpand (hd V3117)) (if (shen.packaged? W3118) (shen.unpackage¯oexpand (cons W3118 (tl V3117))) (cons W3118 (shen.unpackage¯oexpand (tl V3117)))))) (true (shen.f-error shen.unpackage¯oexpand)))) + +(defun shen.packaged? (V3121) (cond ((and (cons? V3121) (and (= package (hd V3121)) (and (cons? (tl V3121)) (cons? (tl (tl V3121)))))) true) (true false))) + +(defun shen.unpackage (V3124) (cond ((and (cons? V3124) (and (= package (hd V3124)) (and (cons? (tl V3124)) (and (= null (hd (tl V3124))) (cons? (tl (tl V3124))))))) (tl (tl (tl V3124)))) ((and (cons? V3124) (and (= package (hd V3124)) (and (cons? (tl V3124)) (cons? (tl (tl V3124)))))) (let W3125 (eval (hd (tl (tl V3124)))) (let W3126 (shen.package-symbols (str (hd (tl V3124))) W3125 (tl (tl (tl V3124)))) (let W3127 (shen.record-external (hd (tl V3124)) W3125) (let W3128 (shen.record-internal (hd (tl V3124)) W3125 (tl (tl (tl V3124)))) W3126))))) (true (shen.f-error shen.unpackage)))) + +(defun shen.record-internal (V3129 V3130 V3131) (let W3132 (trap-error (get V3129 shen.internal-symbols (value *property-vector*)) (lambda Z3133 ())) (let W3134 (shen.internal-symbols (str V3129) V3130 V3131) (put V3129 shen.internal-symbols (union W3134 W3132) (value *property-vector*))))) + +(defun shen.internal-symbols (V3141 V3142 V3143) (cond ((cons? V3143) (union (shen.internal-symbols V3141 V3142 (hd V3143)) (shen.internal-symbols V3141 V3142 (tl V3143)))) ((shen.internal? V3143 V3141 V3142) (cons (shen.intern-in-package V3141 V3143) ())) (true ()))) + +(defun shen.record-external (V3144 V3145) (let W3146 (trap-error (get V3144 shen.external-symbols (value *property-vector*)) (lambda Z3147 ())) (put V3144 shen.external-symbols (union V3145 W3146) (value *property-vector*)))) + +(defun shen.package-symbols (V3152 V3153 V3154) (cond ((cons? V3154) (map (lambda Z3155 (shen.package-symbols V3152 V3153 Z3155)) V3154)) ((shen.internal? V3154 V3152 V3153) (shen.intern-in-package V3152 V3154)) (true V3154))) + +(defun shen.intern-in-package (V3156 V3157) (intern (@s V3156 (@s "." (str V3157))))) + +(defun shen.internal? (V3158 V3159 V3160) (and (not (element? V3158 V3160)) (and (not (shen.sng? V3158)) (and (not (shen.dbl? V3158)) (and (symbol? V3158) (and (not (shen.sysfunc? V3158)) (and (not (variable? V3158)) (and (not (shen.internal-to-shen? (str V3158))) (not (shen.internal-to-P? V3159 (str V3158))))))))))) + +(defun shen.internal-to-shen? (V3165) (cond ((and (shen.+string? V3165) (and (= "s" (hdstr V3165)) (and (shen.+string? (tlstr V3165)) (and (= "h" (hdstr (tlstr V3165))) (and (shen.+string? (tlstr (tlstr V3165))) (and (= "e" (hdstr (tlstr (tlstr V3165)))) (and (shen.+string? (tlstr (tlstr (tlstr V3165)))) (and (= "n" (hdstr (tlstr (tlstr (tlstr V3165))))) (and (shen.+string? (tlstr (tlstr (tlstr (tlstr V3165))))) (= "." (hdstr (tlstr (tlstr (tlstr (tlstr V3165))))))))))))))) true) (true false))) + +(defun shen.sysfunc? (V3166) (element? V3166 (get shen shen.external-symbols (value *property-vector*)))) + +(defun shen.internal-to-P? (V3174 V3175) (cond ((and (= "" V3174) (and (shen.+string? V3175) (= "." (hdstr V3175)))) true) ((and (shen.+string? V3174) (and (shen.+string? V3175) (= (hdstr V3174) (hdstr V3175)))) (shen.internal-to-P? (tlstr V3174) (tlstr V3175))) (true false))) + +(defun shen.process-applications (V3178 V3179) (cond ((element? V3178 V3179) V3178) ((and (cons? V3178) (= cond (hd V3178))) (cons cond (shen.process-cond-clauses (tl V3178) V3179))) ((and (cons? V3178) (shen.non-application? (hd V3178))) (shen.special-case (hd V3178) V3178 V3179)) ((cons? V3178) (shen.process-application (map (lambda Z3180 (shen.process-applications Z3180 V3179)) V3178) V3179)) (true V3178))) + +(defun shen.non-application? (V3183) (cond ((= define V3183) true) ((= defun V3183) true) ((= synonyms V3183) true) ((shen.special? V3183) true) ((shen.extraspecial? V3183) true) (true false))) + +(defun shen.special-case (V3188 V3189 V3190) (cond ((and (= lambda V3188) (and (cons? V3189) (and (= lambda (hd V3189)) (and (cons? (tl V3189)) (and (cons? (tl (tl V3189))) (= () (tl (tl (tl V3189))))))))) (cons lambda (cons (hd (tl V3189)) (cons (shen.process-applications (hd (tl (tl V3189))) V3190) ())))) ((and (= let V3188) (and (cons? V3189) (and (= let (hd V3189)) (and (cons? (tl V3189)) (and (cons? (tl (tl V3189))) (and (cons? (tl (tl (tl V3189)))) (= () (tl (tl (tl (tl V3189))))))))))) (cons let (cons (hd (tl V3189)) (cons (shen.process-applications (hd (tl (tl V3189))) V3190) (cons (shen.process-applications (hd (tl (tl (tl V3189)))) V3190) ()))))) ((and (= defun V3188) (and (cons? V3189) (and (= defun (hd V3189)) (and (cons? (tl V3189)) (and (cons? (tl (tl V3189))) (and (cons? (tl (tl (tl V3189)))) (= () (tl (tl (tl (tl V3189))))))))))) V3189) ((and (= define V3188) (and (cons? V3189) (and (= define (hd V3189)) (and (cons? (tl V3189)) (and (cons? (tl (tl V3189))) (= { (hd (tl (tl V3189))))))))) (cons define (cons (hd (tl V3189)) (cons { (shen.process-after-type (hd (tl V3189)) (tl (tl (tl V3189))) V3190))))) ((and (= define V3188) (and (cons? V3189) (and (= define (hd V3189)) (cons? (tl V3189))))) (cons define (cons (hd (tl V3189)) (map (lambda Z3191 (shen.process-applications Z3191 V3190)) (tl (tl V3189)))))) ((= synonyms V3188) (cons synonyms V3189)) ((and (= type V3188) (and (cons? V3189) (and (= type (hd V3189)) (and (cons? (tl V3189)) (and (cons? (tl (tl V3189))) (= () (tl (tl (tl V3189))))))))) (cons type (cons (shen.process-applications (hd (tl V3189)) V3190) (tl (tl V3189))))) ((and (= input+ V3188) (and (cons? V3189) (and (= input+ (hd V3189)) (and (cons? (tl V3189)) (and (cons? (tl (tl V3189))) (= () (tl (tl (tl V3189))))))))) (cons input+ (cons (hd (tl V3189)) (cons (shen.process-applications (hd (tl (tl V3189))) V3190) ())))) ((and (cons? V3189) (shen.special? (hd V3189))) (cons (hd V3189) (map (lambda Z3192 (shen.process-applications Z3192 V3190)) (tl V3189)))) ((and (cons? V3189) (shen.extraspecial? (hd V3189))) V3189) (true (shen.f-error shen.special-case)))) + +(defun shen.process-cond-clauses (V3195 V3196) (cond ((= () V3195) ()) ((and (cons? V3195) (and (cons? (hd V3195)) (and (cons? (tl (hd V3195))) (= () (tl (tl (hd V3195))))))) (cons (cons (shen.process-applications (hd (hd V3195)) V3196) (cons (shen.process-applications (hd (tl (hd V3195))) V3196) ())) (shen.process-cond-clauses (tl V3195) V3196))) (true (shen.f-error shen.process-cond-clauses)))) + +(defun shen.process-after-type (V3199 V3200 V3201) (cond ((and (cons? V3200) (= } (hd V3200))) (cons } (map (lambda Z3202 (shen.process-applications Z3202 V3201)) (tl V3200)))) ((cons? V3200) (cons (hd V3200) (shen.process-after-type V3199 (tl V3200) V3201))) (true (simple-error (cn "missing } in " (shen.app V3199 " +" shen.a)))))) + +(defun shen.process-application (V3203 V3204) (cond ((cons? V3203) (let W3205 (arity (hd V3203)) (let W3206 (length (tl V3203)) (if (element? V3203 V3204) V3203 (if (shen.shen-call? (hd V3203)) V3203 (if (shen.foreign? V3203) (shen.unpack-foreign V3203) (if (shen.fn-call? V3203) (shen.fn-call V3203) (if (shen.zero-place? V3203) V3203 (if (shen.undefined-f? (hd V3203) W3205) (shen.simple-curry (cons (cons fn (cons (hd V3203) ())) (tl V3203))) (if (variable? (hd V3203)) (shen.simple-curry V3203) (if (shen.application? (hd V3203)) (shen.simple-curry V3203) (if (shen.partial-application*? (hd V3203) W3205 W3206) (shen.lambda-function V3203 (- W3205 W3206)) (if (shen.overapplication? (hd V3203) W3205 W3206) (shen.simple-curry (cons (cons fn (cons (hd V3203) ())) (tl V3203))) V3203))))))))))))) (true (shen.f-error shen.process-application)))) + +(defun shen.unpack-foreign (V3207) (cond ((and (cons? V3207) (and (cons? (hd V3207)) (and (= foreign (hd (hd V3207))) (and (cons? (tl (hd V3207))) (= () (tl (tl (hd V3207)))))))) (cons (hd (tl (hd V3207))) (tl V3207))) (true (shen.f-error shen.unpack-foreign)))) + +(defun shen.foreign? (V3210) (cond ((and (cons? V3210) (and (cons? (hd V3210)) (and (= foreign (hd (hd V3210))) (and (cons? (tl (hd V3210))) (= () (tl (tl (hd V3210)))))))) true) (true false))) + +(defun shen.zero-place? (V3213) (cond ((and (cons? V3213) (= () (tl V3213))) true) (true false))) + +(defun shen.shen-call? (V3214) (and (symbol? V3214) (shen.internal-to-shen? (str V3214)))) + +(defun shen.application? (V3219) (cond ((and (cons? V3219) (and (= protect (hd V3219)) (and (cons? (tl V3219)) (= () (tl (tl V3219)))))) false) ((and (cons? V3219) (and (= foreign (hd V3219)) (and (cons? (tl V3219)) (= () (tl (tl V3219)))))) false) (true (cons? V3219)))) + +(defun shen.undefined-f? (V3224 V3225) (cond ((= -1 V3225) (and (shen.lowercase-symbol? V3224) (not (element? V3224 (external shen))))) (true false))) + +(defun shen.lowercase-symbol? (V3226) (and (symbol? V3226) (not (variable? V3226)))) + +(defun shen.simple-curry (V3227) (cond ((and (cons? V3227) (and (cons? (tl V3227)) (= () (tl (tl V3227))))) V3227) ((and (cons? V3227) (and (cons? (tl V3227)) (cons? (tl (tl V3227))))) (shen.simple-curry (cons (cons (hd V3227) (cons (hd (tl V3227)) ())) (tl (tl V3227))))) (true V3227))) + +(defun function (V3228) (fn V3228)) + +(defun fn (V3229) (cond ((= (arity V3229) 0) (V3229)) (true (trap-error (get V3229 shen.lambda-form (value *property-vector*)) (lambda Z3230 (simple-error (cn "fn: " (shen.app V3229 " is undefined +" shen.a)))))))) + +(defun shen.fn-call? (V3233) (cond ((and (cons? V3233) (and (= fn (hd V3233)) (and (cons? (tl V3233)) (= () (tl (tl V3233)))))) true) ((and (cons? V3233) (and (= function (hd V3233)) (and (cons? (tl V3233)) (= () (tl (tl V3233)))))) true) (true false))) + +(defun shen.fn-call (V3234) (cond ((and (cons? V3234) (and (= function (hd V3234)) (and (cons? (tl V3234)) (= () (tl (tl V3234)))))) (shen.fn-call (cons fn (tl V3234)))) ((and (cons? V3234) (and (= fn (hd V3234)) (and (cons? (tl V3234)) (= () (tl (tl V3234)))))) (let W3235 (arity (hd (tl V3234))) (if (= W3235 -1) V3234 (if (= W3235 0) (tl V3234) (shen.lambda-function (tl V3234) W3235))))) (true (shen.f-error shen.fn-call)))) + +(defun shen.partial-application*? (V3236 V3237 V3238) (let W3239 (> V3237 V3238) (let W3240 (if (and W3239 (and (shen.loading?) (not (element? V3236 (cons + (cons - ())))))) (pr (cn "partial application of " (shen.app V3236 " +" shen.a)) (stoutput)) shen.skip) W3239))) + +(defun shen.loading? () (value shen.*loading?*)) + +(defun shen.overapplication? (V3245 V3246 V3247) (cond ((= -1 V3246) false) (true (let W3248 (< V3246 V3247) (let W3249 (if (and W3248 (shen.loading?)) (pr (shen.app V3245 (cn " might not like " (shen.app V3247 (cn " argument" (shen.app (if (= V3247 1) "" "s") " +" shen.a)) shen.a)) shen.a) (stoutput)) shen.skip) W3248))))) + +(defun shen.compile-prolog (V1640 V1641) (compile (lambda Z1642 (shen. Z1642)) (cons V1640 V1641))) + +(defun shen. (V1643) (let W1644 (if (cons? V1643) (let W1645 (head V1643) (let W1646 (tail V1643) (let W1647 (shen. W1646) (if (shen.parse-failure? W1647) (shen.parse-failure) (let W1648 (shen.<-out W1647) (let W1649 (shen.in-> W1647) (shen.comb W1649 (let W1650 (shen.prolog-arity-check W1645 W1648) (let W1651 (map (lambda Z1652 (shen.linearise-clause Z1652)) W1648) (shen.horn-clause-procedure W1645 W1651)))))))))) (shen.parse-failure)) (if (shen.parse-failure? W1644) (shen.parse-failure) W1644))) + +(defun shen.prolog-arity-check (V1655 V1656) (cond ((and (cons? V1656) (and (cons? (hd V1656)) (and (cons? (tl (hd V1656))) (and (= () (tl (tl (hd V1656)))) (= () (tl V1656)))))) (length (hd (hd V1656)))) ((and (cons? V1656) (and (cons? (hd V1656)) (and (cons? (tl (hd V1656))) (= () (tl (tl (hd V1656))))))) (shen.pac-h V1655 (length (hd (hd V1656))) (tl V1656))) (true (shen.f-error shen.prolog-arity-check)))) + +(defun shen.pac-h (V1661 V1662 V1663) (cond ((= () V1663) V1662) ((and (cons? V1663) (cons? (hd V1663))) (if (= V1662 (length (hd (hd V1663)))) (shen.pac-h V1661 V1662 (tl V1663)) (simple-error (cn "arity error in prolog procedure " (shen.app V1661 " +" shen.a))))) (true (shen.f-error shen.pac-h)))) + +(defun shen. (V1664) (let W1665 (let W1666 (shen. V1664) (if (shen.parse-failure? W1666) (shen.parse-failure) (let W1667 (shen.<-out W1666) (let W1668 (shen.in-> W1666) (let W1669 (shen. W1668) (if (shen.parse-failure? W1669) (shen.parse-failure) (let W1670 (shen.<-out W1669) (let W1671 (shen.in-> W1669) (shen.comb W1671 (cons W1667 W1670)))))))))) (if (shen.parse-failure? W1665) (let W1672 (let W1673 ( V1664) (if (shen.parse-failure? W1673) (shen.parse-failure) (let W1674 (shen.<-out W1673) (let W1675 (shen.in-> W1673) (shen.comb W1675 (if (empty? W1674) () (simple-error (cn "Prolog syntax error here: + " (shen.app W1674 " + ..." shen.r))))))))) (if (shen.parse-failure? W1672) (shen.parse-failure) W1672)) W1665))) + +(defun shen.linearise-clause (V1676) (cond ((and (cons? V1676) (and (cons? (tl V1676)) (= () (tl (tl V1676))))) (shen.lch (shen.linearise (@p (hd V1676) (hd (tl V1676)))))) (true (shen.f-error shen.linearise-clause)))) + +(defun shen.lch (V1677) (cond ((tuple? V1677) (cons (fst V1677) (cons (shen.lchh (snd V1677)) ()))) (true (shen.f-error shen.lch)))) + +(defun shen.lchh (V1678) (cond ((and (cons? V1678) (and (= where (hd V1678)) (and (cons? (tl V1678)) (and (cons? (hd (tl V1678))) (and (= = (hd (hd (tl V1678)))) (and (cons? (tl (hd (tl V1678)))) (and (cons? (tl (tl (hd (tl V1678))))) (and (= () (tl (tl (tl (hd (tl V1678)))))) (and (cons? (tl (tl V1678))) (= () (tl (tl (tl V1678))))))))))))) (cons (cons (if (value shen.*occurs*) is! is) (tl (hd (tl V1678)))) (shen.lchh (hd (tl (tl V1678)))))) (true V1678))) + +(defun shen. (V1679) (let W1680 (let W1681 (shen. V1679) (if (shen.parse-failure? W1681) (shen.parse-failure) (let W1682 (shen.<-out W1681) (let W1683 (shen.in-> W1681) (if (shen.hds=? W1683 <--) (let W1684 (tail W1683) (let W1685 (shen. W1684) (if (shen.parse-failure? W1685) (shen.parse-failure) (let W1686 (shen.<-out W1685) (let W1687 (shen.in-> W1685) (let W1688 (shen. W1687) (if (shen.parse-failure? W1688) (shen.parse-failure) (let W1689 (shen.in-> W1688) (shen.comb W1689 (cons W1682 (cons W1686 ()))))))))))) (shen.parse-failure)))))) (if (shen.parse-failure? W1680) (shen.parse-failure) W1680))) + +(defun shen. (V1690) (let W1691 (let W1692 (shen. V1690) (if (shen.parse-failure? W1692) (shen.parse-failure) (let W1693 (shen.<-out W1692) (let W1694 (shen.in-> W1692) (let W1695 (shen. W1694) (if (shen.parse-failure? W1695) (shen.parse-failure) (let W1696 (shen.<-out W1695) (let W1697 (shen.in-> W1695) (shen.comb W1697 (cons W1693 W1696)))))))))) (if (shen.parse-failure? W1691) (let W1698 (let W1699 ( V1690) (if (shen.parse-failure? W1699) (shen.parse-failure) (let W1700 (shen.in-> W1699) (shen.comb W1700 ())))) (if (shen.parse-failure? W1698) (shen.parse-failure) W1698)) W1691))) + +(defun shen. (V1701) (let W1702 (if (cons? V1701) (let W1703 (head V1701) (let W1704 (tail V1701) (if (and (atom? W1703) (not (shen.prolog-keyword? W1703))) (shen.comb W1704 W1703) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W1702) (let W1705 (if (cons? V1701) (let W1706 (head V1701) (let W1707 (tail V1701) (if (= W1706 (intern ":")) (shen.comb W1707 W1706) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W1705) (let W1708 (if (shen.ccons? V1701) (let W1709 (head V1701) (let W1710 (tail V1701) (if (shen.hds=? W1709 cons) (let W1711 (tail W1709) (let W1712 (shen. W1711) (if (shen.parse-failure? W1712) (shen.parse-failure) (let W1713 (shen.<-out W1712) (let W1714 (shen.in-> W1712) (let W1715 (shen. W1714) (if (shen.parse-failure? W1715) (shen.parse-failure) (let W1716 (shen.<-out W1715) (let W1717 (shen.in-> W1715) (let W1718 ( W1717) (if (shen.parse-failure? W1718) (shen.parse-failure) (let W1719 (shen.in-> W1718) (shen.comb W1710 (cons cons (cons W1713 (cons W1716 ())))))))))))))))) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W1708) (let W1720 (if (shen.ccons? V1701) (let W1721 (head V1701) (let W1722 (tail V1701) (if (shen.hds=? W1721 +) (let W1723 (tail W1721) (let W1724 (shen. W1723) (if (shen.parse-failure? W1724) (shen.parse-failure) (let W1725 (shen.<-out W1724) (let W1726 (shen.in-> W1724) (let W1727 ( W1726) (if (shen.parse-failure? W1727) (shen.parse-failure) (let W1728 (shen.in-> W1727) (shen.comb W1722 (cons shen.+m (cons W1725 ()))))))))))) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W1720) (let W1729 (if (shen.ccons? V1701) (let W1730 (head V1701) (let W1731 (tail V1701) (if (shen.hds=? W1730 -) (let W1732 (tail W1730) (let W1733 (shen. W1732) (if (shen.parse-failure? W1733) (shen.parse-failure) (let W1734 (shen.<-out W1733) (let W1735 (shen.in-> W1733) (let W1736 ( W1735) (if (shen.parse-failure? W1736) (shen.parse-failure) (let W1737 (shen.in-> W1736) (shen.comb W1731 (cons shen.-m (cons W1734 ()))))))))))) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W1729) (let W1738 (if (shen.ccons? V1701) (let W1739 (head V1701) (let W1740 (tail V1701) (if (shen.hds=? W1739 mode) (let W1741 (tail W1739) (let W1742 (shen. W1741) (if (shen.parse-failure? W1742) (shen.parse-failure) (let W1743 (shen.<-out W1742) (let W1744 (shen.in-> W1742) (if (shen.hds=? W1744 +) (let W1745 (tail W1744) (let W1746 ( W1745) (if (shen.parse-failure? W1746) (shen.parse-failure) (let W1747 (shen.in-> W1746) (shen.comb W1740 (cons shen.+m (cons W1743 ()))))))) (shen.parse-failure))))))) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W1738) (let W1748 (if (shen.ccons? V1701) (let W1749 (head V1701) (let W1750 (tail V1701) (if (shen.hds=? W1749 mode) (let W1751 (tail W1749) (let W1752 (shen. W1751) (if (shen.parse-failure? W1752) (shen.parse-failure) (let W1753 (shen.<-out W1752) (let W1754 (shen.in-> W1752) (if (shen.hds=? W1754 -) (let W1755 (tail W1754) (let W1756 ( W1755) (if (shen.parse-failure? W1756) (shen.parse-failure) (let W1757 (shen.in-> W1756) (shen.comb W1750 (cons shen.-m (cons W1753 ()))))))) (shen.parse-failure))))))) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W1748) (shen.parse-failure) W1748)) W1738)) W1729)) W1720)) W1708)) W1705)) W1702))) + +(defun shen.prolog-keyword? (V1758) (element? V1758 (cons (intern ";") (cons <-- ())))) + +(defun atom? (V1759) (or (symbol? V1759) (or (string? V1759) (or (boolean? V1759) (or (number? V1759) (empty? V1759)))))) + +(defun shen. (V1760) (let W1761 (let W1762 (shen. V1760) (if (shen.parse-failure? W1762) (shen.parse-failure) (let W1763 (shen.<-out W1762) (let W1764 (shen.in-> W1762) (shen.comb W1764 W1763))))) (if (shen.parse-failure? W1761) (shen.parse-failure) W1761))) + +(defun shen. (V1765) (let W1766 (let W1767 (shen. V1765) (if (shen.parse-failure? W1767) (shen.parse-failure) (let W1768 (shen.<-out W1767) (let W1769 (shen.in-> W1767) (shen.comb W1769 W1768))))) (if (shen.parse-failure? W1766) (shen.parse-failure) W1766))) + +(defun shen. (V1770) (let W1771 (let W1772 (shen. V1770) (if (shen.parse-failure? W1772) (shen.parse-failure) (let W1773 (shen.<-out W1772) (let W1774 (shen.in-> W1772) (let W1775 (shen. W1774) (if (shen.parse-failure? W1775) (shen.parse-failure) (let W1776 (shen.<-out W1775) (let W1777 (shen.in-> W1775) (shen.comb W1777 (cons W1773 W1776)))))))))) (if (shen.parse-failure? W1771) (let W1778 (let W1779 ( V1770) (if (shen.parse-failure? W1779) (shen.parse-failure) (let W1780 (shen.in-> W1779) (shen.comb W1780 ())))) (if (shen.parse-failure? W1778) (shen.parse-failure) W1778)) W1771))) + +(defun shen. (V1781) (let W1782 (if (shen.hds=? V1781 !) (let W1783 (tail V1781) (shen.comb W1783 !)) (shen.parse-failure)) (if (shen.parse-failure? W1782) (let W1784 (if (shen.ccons? V1781) (let W1785 (head V1781) (let W1786 (tail V1781) (let W1787 (shen. W1785) (if (shen.parse-failure? W1787) (shen.parse-failure) (let W1788 (shen.<-out W1787) (let W1789 (shen.in-> W1787) (let W1790 ( W1789) (if (shen.parse-failure? W1790) (shen.parse-failure) (let W1791 (shen.in-> W1790) (shen.comb W1786 W1788)))))))))) (shen.parse-failure)) (if (shen.parse-failure? W1784) (shen.parse-failure) W1784)) W1782))) + +(defun shen. (V1792) (let W1793 (let W1794 (shen. V1792) (if (shen.parse-failure? W1794) (shen.parse-failure) (let W1795 (shen.<-out W1794) (let W1796 (shen.in-> W1794) (let W1797 (shen. W1796) (if (shen.parse-failure? W1797) (shen.parse-failure) (let W1798 (shen.<-out W1797) (let W1799 (shen.in-> W1797) (shen.comb W1799 (cons W1795 W1798)))))))))) (if (shen.parse-failure? W1793) (let W1800 (let W1801 ( V1792) (if (shen.parse-failure? W1801) (shen.parse-failure) (let W1802 (shen.in-> W1801) (shen.comb W1802 ())))) (if (shen.parse-failure? W1800) (shen.parse-failure) W1800)) W1793))) + +(defun shen. (V1803) (let W1804 (let W1805 (shen. V1803) (if (shen.parse-failure? W1805) (shen.parse-failure) (let W1806 (shen.<-out W1805) (let W1807 (shen.in-> W1805) (shen.comb W1807 W1806))))) (if (shen.parse-failure? W1804) (let W1808 (if (cons? V1803) (let W1809 (head V1803) (let W1810 (tail V1803) (if (atom? W1809) (shen.comb W1810 W1809) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W1808) (let W1811 (if (shen.ccons? V1803) (let W1812 (head V1803) (let W1813 (tail V1803) (let W1814 (shen. W1812) (if (shen.parse-failure? W1814) (shen.parse-failure) (let W1815 (shen.<-out W1814) (let W1816 (shen.in-> W1814) (let W1817 ( W1816) (if (shen.parse-failure? W1817) (shen.parse-failure) (let W1818 (shen.in-> W1817) (shen.comb W1813 W1815)))))))))) (shen.parse-failure)) (if (shen.parse-failure? W1811) (shen.parse-failure) W1811)) W1808)) W1804))) + +(defun shen. (V1819) (let W1820 (if (cons? V1819) (let W1821 (head V1819) (let W1822 (tail V1819) (if (= W1821 _) (shen.comb W1822 (gensym Y)) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W1820) (shen.parse-failure) W1820))) + +(defun shen. (V1823) (let W1824 (if (cons? V1823) (let W1825 (head V1823) (let W1826 (tail V1823) (if (shen.semicolon? W1825) (shen.comb W1826 W1825) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W1824) (shen.parse-failure) W1824))) + +(defun shen.horn-clause-procedure (V1827 V1828) (let W1829 (gensym B) (let W1830 (gensym L) (let W1831 (gensym K) (let W1832 (gensym C) (let W1833 (shen.prolog-parameters V1828) (let W1834 (shen.hascut? V1828) (let W1835 (shen.prolog-fbody V1828 W1833 W1829 W1830 W1831 W1832 W1834) (let W1836 (if W1834 (cons let (cons W1831 (cons (cons + (cons W1831 (cons 1 ()))) (cons W1835 ())))) W1835) (let W1837 (cons define (cons V1827 (append W1833 (append (cons W1829 (cons W1830 (cons W1831 (cons W1832 (cons -> ()))))) (cons W1836 ()))))) W1837)))))))))) + +(defun shen.hascut? (V1840) (cond ((= ! V1840) true) ((cons? V1840) (or (shen.hascut? (hd V1840)) (shen.hascut? (tl V1840)))) (true false))) + +(defun shen.prolog-parameters (V1845) (cond ((and (cons? V1845) (cons? (hd V1845))) (shen.parameters (length (hd (hd V1845))))) (true (shen.f-error shen.prolog-parameters)))) + +(defun shen.prolog-fbody (V1866 V1867 V1868 V1869 V1870 V1871 V1872) (cond ((and (= () V1866) (= true V1872)) (cons shen.unlock (cons V1869 (cons V1870 ())))) ((and (cons? V1866) (and (cons? (hd V1866)) (and (cons? (tl (hd V1866))) (and (= () (tl (tl (hd V1866)))) (and (= () (tl V1866)) (= false V1872)))))) (let W1873 (shen.continue (hd (hd V1866)) (hd (tl (hd V1866))) V1868 V1869 V1870 V1871) (cons if (cons (cons shen.unlocked? (cons V1869 ())) (cons (shen.compile-head shen.+m (hd (hd V1866)) V1867 V1868 W1873) (cons false ())))))) ((and (cons? V1866) (and (cons? (hd V1866)) (and (cons? (tl (hd V1866))) (= () (tl (tl (hd V1866))))))) (let W1874 (gensym C) (let W1875 (shen.continue (hd (hd V1866)) (hd (tl (hd V1866))) V1868 V1869 V1870 V1871) (cons let (cons W1874 (cons (cons if (cons (cons shen.unlocked? (cons V1869 ())) (cons (shen.compile-head shen.+m (hd (hd V1866)) V1867 V1868 W1875) (cons false ())))) (cons (cons if (cons (cons = (cons W1874 (cons false ()))) (cons (shen.prolog-fbody (tl V1866) V1867 V1868 V1869 V1870 V1871 V1872) (cons W1874 ())))) ()))))))) (true (simple-error "implementation error in shen.prolog-fbody")))) + +(defun shen.unlock (V1876 V1877) (if (and (shen.locked? V1876) (shen.fits? V1877 V1876)) (shen.openlock V1876) false)) + +(defun shen.locked? (V1878) (not (shen.unlocked? V1878))) + +(defun shen.unlocked? (V1879) (<-address V1879 1)) + +(defun shen.openlock (V1880) (do (address-> V1880 1 true) false)) + +(defun shen.fits? (V1881 V1882) (= V1881 (<-address V1882 2))) + +(defun shen.cut (V1885 V1886 V1887 V1888) (let W1889 (thaw V1888) (if (and (= W1889 false) (shen.unlocked? V1886)) (shen.lock V1887 V1886) W1889))) + +(defun shen.lock (V1890 V1891) (let W1892 (address-> V1891 1 false) (let W1893 (address-> V1891 2 V1890) false))) + +(defun shen.continue (V1894 V1895 V1896 V1897 V1898 V1899) (let W1900 (shen.extract-vars V1894) (let W1901 (shen.extract-free-vars V1895) (let W1902 (difference W1901 W1900) (let W1903 (cons do (cons (cons shen.incinfs ()) (cons (shen.compile-body V1895 V1896 V1897 V1898 V1899) ()))) (shen.stpart W1902 W1903 V1896)))))) + +(defun shen.extract-free-vars (V1906) (cond ((and (cons? V1906) (and (= lambda (hd V1906)) (and (cons? (tl V1906)) (and (cons? (tl (tl V1906))) (= () (tl (tl (tl V1906)))))))) (remove (hd (tl V1906)) (shen.extract-free-vars (hd (tl (tl V1906)))))) ((cons? V1906) (union (shen.extract-free-vars (hd V1906)) (shen.extract-free-vars (tl V1906)))) ((variable? V1906) (cons V1906 ())) (true ()))) + +(defun shen.compile-body (V1923 V1924 V1925 V1926 V1927) (cond ((= () V1923) (cons thaw (cons V1927 ()))) ((and (cons? V1923) (= ! (hd V1923))) (shen.compile-body (cons (cons shen.cut ()) (tl V1923)) V1924 V1925 V1926 V1927)) ((and (cons? V1923) (= () (tl V1923))) (append (shen.deref-calls (hd V1923) V1924) (cons V1924 (cons V1925 (cons V1926 (cons V1927 ())))))) ((cons? V1923) (let W1928 (shen.deref-calls (hd V1923) V1924) (append W1928 (cons V1924 (cons V1925 (cons V1926 (cons (shen.freeze-literals (tl V1923) V1924 V1925 V1926 V1927) ()))))))) (true (simple-error "implementation error in shen.compile-fbody")))) + +(defun shen.freeze-literals (V1945 V1946 V1947 V1948 V1949) (cond ((= () V1945) V1949) ((and (cons? V1945) (= ! (hd V1945))) (shen.freeze-literals (cons (cons shen.cut ()) (tl V1945)) V1946 V1947 V1948 V1949)) ((cons? V1945) (let W1950 (shen.deref-calls (hd V1945) V1946) (cons freeze (cons (append W1950 (cons V1946 (cons V1947 (cons V1948 (cons (shen.freeze-literals (tl V1945) V1946 V1947 V1948 V1949) ()))))) ())))) (true (simple-error "implementation error in shen.freeze-literals")))) + +(defun shen.deref-calls (V1955 V1956) (cond ((and (cons? V1955) (= fork (hd V1955))) (cons fork (cons (shen.deref-forked-literals (tl V1955) V1956) ()))) ((cons? V1955) (cons (hd V1955) (map (lambda Z1957 (shen.function-calls Z1957 V1956)) (tl V1955)))) (true (simple-error "implementation error in shen.deref-calls")))) + +(defun shen.deref-forked-literals (V1964 V1965) (cond ((= () V1964) ()) ((cons? V1964) (cons cons (cons (shen.deref-calls (hd V1964) V1965) (cons (shen.deref-forked-literals (tl V1964) V1965) ())))) (true (simple-error "fork requires a list of literals +")))) + +(defun shen.function-calls (V1968 V1969) (cond ((and (cons? V1968) (and (= cons (hd V1968)) (and (cons? (tl V1968)) (and (cons? (tl (tl V1968))) (= () (tl (tl (tl V1968)))))))) (cons cons (cons (shen.function-calls (hd (tl V1968)) V1969) (cons (shen.function-calls (hd (tl (tl V1968))) V1969) ())))) ((cons? V1968) (shen.deref-terms V1968 V1969 ())) (true V1968))) + +(defun shen.deref-terms (V1978 V1979 V1980) (cond ((and (cons? V1978) (and (= 0 (hd V1978)) (and (cons? (tl V1978)) (= () (tl (tl V1978)))))) (if (variable? (hd (tl V1978))) (hd (tl V1978)) (simple-error (cn "attempt to optimise a non-variable " (shen.app (hd (tl V1978)) " +" shen.s))))) ((and (cons? V1978) (and (= 1 (hd V1978)) (and (cons? (tl V1978)) (= () (tl (tl V1978)))))) (if (variable? (hd (tl V1978))) (cons shen.lazyderef (cons (hd (tl V1978)) (cons V1979 ()))) (simple-error (cn "attempt to optimise a non-variable " (shen.app (hd (tl V1978)) " +" shen.s))))) ((and (not (element? V1978 V1980)) (variable? V1978)) (cons shen.deref (cons V1978 (cons V1979 ())))) ((and (cons? V1978) (and (= lambda (hd V1978)) (and (cons? (tl V1978)) (and (cons? (tl (tl V1978))) (= () (tl (tl (tl V1978)))))))) (cons lambda (cons (hd (tl V1978)) (cons (shen.deref-terms (hd (tl (tl V1978))) V1979 (cons (hd (tl V1978)) V1980)) ())))) ((cons? V1978) (map (lambda Z1981 (shen.deref-terms Z1981 V1979 V1980)) V1978)) (true V1978))) + +(defun shen.compile-head (V1999 V2000 V2001 V2002 V2003) (cond ((and (= () V2000) (= () V2001)) V2003) ((and (cons? V2000) (and (cons? (hd V2000)) (and (= shen.+m (hd (hd V2000))) (and (cons? (tl (hd V2000))) (= () (tl (tl (hd V2000)))))))) (shen.compile-head V1999 (cons shen.+m (cons (hd (tl (hd V2000))) (cons V1999 (tl V2000)))) V2001 V2002 V2003)) ((and (cons? V2000) (and (cons? (hd V2000)) (and (= shen.-m (hd (hd V2000))) (and (cons? (tl (hd V2000))) (= () (tl (tl (hd V2000)))))))) (shen.compile-head V1999 (cons shen.-m (cons (hd (tl (hd V2000))) (cons V1999 (tl V2000)))) V2001 V2002 V2003)) ((and (cons? V2000) (= shen.-m (hd V2000))) (shen.compile-head shen.-m (tl V2000) V2001 V2002 V2003)) ((and (cons? V2000) (= shen.+m (hd V2000))) (shen.compile-head shen.+m (tl V2000) V2001 V2002 V2003)) ((and (cons? V2000) (and (cons? V2001) (shen.wildcard? (hd V2000)))) (shen.compile-head V1999 (tl V2000) (tl V2001) V2002 V2003)) ((and (cons? V2000) (variable? (hd V2000))) (shen.variable-case V1999 V2000 V2001 V2002 V2003)) ((and (= shen.-m V1999) (and (cons? V2000) (atom? (hd V2000)))) (shen.atom-case-minus V2000 V2001 V2002 V2003)) ((and (= shen.-m V1999) (and (cons? V2000) (and (cons? (hd V2000)) (and (= cons (hd (hd V2000))) (and (cons? (tl (hd V2000))) (and (cons? (tl (tl (hd V2000)))) (= () (tl (tl (tl (hd V2000))))))))))) (shen.cons-case-minus V2000 V2001 V2002 V2003)) ((and (= shen.+m V1999) (and (cons? V2000) (atom? (hd V2000)))) (shen.atom-case-plus V2000 V2001 V2002 V2003)) ((and (= shen.+m V1999) (and (cons? V2000) (and (cons? (hd V2000)) (and (= cons (hd (hd V2000))) (and (cons? (tl (hd V2000))) (and (cons? (tl (tl (hd V2000)))) (= () (tl (tl (tl (hd V2000))))))))))) (shen.cons-case-plus V2000 V2001 V2002 V2003)) (true (simple-error "implementation error in shen.compile-head")))) + +(defun shen.variable-case (V2014 V2015 V2016 V2017 V2018) (cond ((and (cons? V2015) (cons? V2016)) (if (variable? (hd V2016)) (shen.compile-head V2014 (tl V2015) (tl V2016) V2017 (subst (hd V2016) (hd V2015) V2018)) (cons let (cons (hd V2015) (cons (hd V2016) (cons (shen.compile-head V2014 (tl V2015) (tl V2016) V2017 V2018) ())))))) (true (simple-error "implementation error in shen.variable-case")))) + +(defun shen.atom-case-minus (V2027 V2028 V2029 V2030) (cond ((and (cons? V2027) (cons? V2028)) (let W2031 (gensym Tm) (cons let (cons W2031 (cons (cons shen.lazyderef (cons (hd V2028) (cons V2029 ()))) (cons (cons if (cons (cons = (cons W2031 (cons (hd V2027) ()))) (cons (shen.compile-head shen.-m (tl V2027) (tl V2028) V2029 V2030) (cons false ())))) ())))))) (true (simple-error "implementation error in shen.atom-case-minus")))) + +(defun shen.cons-case-minus (V2040 V2041 V2042 V2043) (cond ((and (cons? V2040) (and (cons? (hd V2040)) (and (= cons (hd (hd V2040))) (and (cons? (tl (hd V2040))) (and (cons? (tl (tl (hd V2040)))) (and (= () (tl (tl (tl (hd V2040))))) (cons? V2041))))))) (let W2044 (gensym Tm) (cons let (cons W2044 (cons (cons shen.lazyderef (cons (hd V2041) (cons V2042 ()))) (cons (cons if (cons (cons cons? (cons W2044 ())) (cons (shen.compile-head shen.-m (cons (hd (tl (hd V2040))) (cons (hd (tl (tl (hd V2040)))) (tl V2040))) (cons (cons hd (cons W2044 ())) (cons (cons tl (cons W2044 ())) (tl V2041))) V2042 V2043) (cons false ())))) ())))))) (true (simple-error "implementation error in shen.cons-case-minus")))) + +(defun shen.atom-case-plus (V2053 V2054 V2055 V2056) (cond ((and (cons? V2053) (cons? V2054)) (let W2057 (gensym Tm) (let W2058 (gensym GoTo) (cons let (cons W2057 (cons (cons shen.lazyderef (cons (hd V2054) (cons V2055 ()))) (cons W2058 (cons (cons freeze (cons (shen.compile-head shen.+m (tl V2053) (tl V2054) V2055 V2056) ())) (cons (cons if (cons (cons = (cons W2057 (cons (hd V2053) ()))) (cons (cons thaw (cons W2058 ())) (cons (cons if (cons (cons shen.pvar? (cons W2057 ())) (cons (cons shen.bind! (cons W2057 (cons (shen.demode (hd V2053)) (cons V2055 (cons W2058 ()))))) (cons false ())))) ())))) ()))))))))) (true (simple-error "implementation error in shen.atom-case-plus")))) + +(defun shen.cons-case-plus (V2067 V2068 V2069 V2070) (cond ((and (cons? V2067) (and (cons? (hd V2067)) (and (= cons (hd (hd V2067))) (and (cons? (tl (hd V2067))) (and (cons? (tl (tl (hd V2067)))) (and (= () (tl (tl (tl (hd V2067))))) (cons? V2068))))))) (let W2071 (gensym Tm) (let W2072 (gensym GoTo) (let W2073 (shen.extract-vars (cons (hd (tl (hd V2067))) (hd (tl (tl (hd V2067)))))) (let W2074 (shen.tame (hd V2067)) (let W2075 (shen.extract-vars W2074) (cons let (cons W2071 (cons (cons shen.lazyderef (cons (hd V2068) (cons V2069 ()))) (cons W2072 (cons (shen.goto W2073 (shen.compile-head shen.+m (tl V2067) (tl V2068) V2069 V2070)) (cons (cons if (cons (cons cons? (cons W2071 ())) (cons (shen.compile-head shen.+m (tl (hd V2067)) (cons (cons hd (cons W2071 ())) (cons (cons tl (cons W2071 ())) ())) V2069 (shen.invoke W2072 W2073)) (cons (cons if (cons (cons shen.pvar? (cons W2071 ())) (cons (shen.stpart W2075 (cons shen.bind! (cons W2071 (cons (shen.demode W2074) (cons V2069 (cons (cons freeze (cons (shen.invoke W2072 W2073) ())) ()))))) V2069) (cons false ())))) ())))) ())))))))))))) (true (simple-error "implementation error in shen.cons-case-plus")))) + +(defun shen.demode (V2076) (cond ((and (cons? V2076) (and (= shen.+m (hd V2076)) (and (cons? (tl V2076)) (= () (tl (tl V2076)))))) (shen.demode (hd (tl V2076)))) ((and (cons? V2076) (and (= shen.-m (hd V2076)) (and (cons? (tl V2076)) (= () (tl (tl V2076)))))) (shen.demode (hd (tl V2076)))) ((cons? V2076) (map (lambda Z2077 (shen.demode Z2077)) V2076)) (true V2076))) + +(defun shen.tame (V2078) (cond ((shen.wildcard? V2078) (gensym Y)) ((cons? V2078) (map (lambda Z2079 (shen.tame Z2079)) V2078)) (true V2078))) + +(defun shen.goto (V2080 V2081) (cond ((= () V2080) (cons freeze (cons V2081 ()))) (true (shen.goto-h V2080 V2081)))) + +(defun shen.goto-h (V2082 V2083) (cond ((= () V2082) V2083) ((cons? V2082) (cons lambda (cons (hd V2082) (cons (shen.goto-h (tl V2082) V2083) ())))) (true (shen.f-error shen.goto-h)))) + +(defun shen.invoke (V2084 V2085) (cond ((= () V2085) (cons thaw (cons V2084 ()))) (true (cons V2084 V2085)))) + +(defun shen.wildcard? (V2086) (= V2086 _)) + +(defun shen.pvar? (V2087) (and (absvector? V2087) (= (trap-error (<-address V2087 0) (lambda Z2088 shen.not-pvar)) shen.pvar))) + +(defun shen.lazyderef (V2089 V2090) (if (shen.pvar? V2089) (let W2091 (<-address V2090 (<-address V2089 1)) (if (= W2091 shen.-null-) V2089 (shen.lazyderef W2091 V2090))) V2089)) + +(defun shen.deref (V2092 V2093) (cond ((cons? V2092) (cons (shen.deref (hd V2092) V2093) (shen.deref (tl V2092) V2093))) (true (if (shen.pvar? V2092) (let W2094 (<-address V2093 (<-address V2092 1)) (if (= W2094 shen.-null-) V2092 (shen.deref W2094 V2093))) V2092)))) + +(defun shen.bind! (V2095 V2096 V2097 V2098) (let W2099 (shen.bindv V2095 V2096 V2097) (let W2100 (thaw V2098) (if (= W2100 false) (shen.unwind V2095 V2097 W2100) W2100)))) + +(defun shen.bindv (V2101 V2102 V2103) (address-> V2103 (<-address V2101 1) V2102)) + +(defun shen.unwind (V2104 V2105 V2106) (do (address-> V2105 (<-address V2104 1) shen.-null-) V2106)) + +(defun shen.stpart (V2115 V2116 V2117) (cond ((= () V2115) V2116) ((cons? V2115) (cons let (cons (hd V2115) (cons (cons shen.newpv (cons V2117 ())) (cons (cons shen.gc (cons V2117 (cons (shen.stpart (tl V2115) V2116 V2117) ()))) ()))))) (true (simple-error "implementation error in shen.stpart")))) + +(defun shen.gc (V2118 V2119) (if (= V2119 false) (let W2120 (shen.ticket-number V2118) (do (shen.decrement-ticket W2120 V2118) V2119)) V2119)) + +(defun shen.decrement-ticket (V2121 V2122) (address-> V2122 1 (- V2121 1))) + +(defun shen.newpv (V2123) (let W2124 (shen.ticket-number V2123) (let W2125 (shen.make-prolog-variable W2124) (let W2126 (shen.nextticket V2123 W2124) W2125)))) + +(defun shen.ticket-number (V2127) (<-address V2127 1)) + +(defun shen.nextticket (V2128 V2129) (let W2130 (address-> V2128 V2129 shen.-null-) (address-> W2130 1 (+ V2129 1)))) + +(defun shen.make-prolog-variable (V2131) (address-> (address-> (absvector 2) 0 shen.pvar) 1 V2131)) + +(defun shen.pvar (V2132) (cn "Var" (shen.app (<-address V2132 1) "" shen.a))) + +(defun shen.incinfs () (set shen.*infs* (+ 1 (value shen.*infs*)))) + +(defun shen.lzy=! (V2145 V2146 V2147 V2148) (cond ((= V2145 V2146) (thaw V2148)) ((and (shen.pvar? V2145) (not (shen.occurs-check? V2145 (shen.deref V2146 V2147)))) (shen.bind! V2145 V2146 V2147 V2148)) ((and (shen.pvar? V2146) (not (shen.occurs-check? V2146 (shen.deref V2145 V2147)))) (shen.bind! V2146 V2145 V2147 V2148)) ((and (cons? V2145) (cons? V2146)) (shen.lzy=! (shen.lazyderef (hd V2145) V2147) (shen.lazyderef (hd V2146) V2147) V2147 (freeze (shen.lzy=! (shen.lazyderef (tl V2145) V2147) (shen.lazyderef (tl V2146) V2147) V2147 V2148)))) (true false))) + +(defun shen.lzy= (V2160 V2161 V2162 V2163) (cond ((= V2160 V2161) (thaw V2163)) ((shen.pvar? V2160) (shen.bind! V2160 V2161 V2162 V2163)) ((shen.pvar? V2161) (shen.bind! V2161 V2160 V2162 V2163)) ((and (cons? V2160) (cons? V2161)) (shen.lzy= (shen.lazyderef (hd V2160) V2162) (shen.lazyderef (hd V2161) V2162) V2162 (freeze (shen.lzy= (shen.lazyderef (tl V2160) V2162) (shen.lazyderef (tl V2161) V2162) V2162 V2163)))) (true false))) + +(defun shen.occurs-check? (V2169 V2170) (cond ((= V2169 V2170) true) ((cons? V2170) (or (shen.occurs-check? V2169 (hd V2170)) (shen.occurs-check? V2169 (tl V2170)))) (true false))) + +(defun call (V2171 V2172 V2173 V2174 V2175) ((((V2171 V2172) V2173) V2174) V2175)) + +(defun return (V2182 V2183 V2184 V2185 V2186) (shen.deref V2182 V2183)) + +(defun when (V2193 V2194 V2195 V2196 V2197) (if V2193 (thaw V2197) false)) + +(defun is (V2198 V2199 V2200 V2201 V2202 V2203) (shen.lzy= (shen.lazyderef V2198 V2200) (shen.lazyderef V2199 V2200) V2200 V2203)) + +(defun is! (V2204 V2205 V2206 V2207 V2208 V2209) (shen.lzy=! (shen.lazyderef V2204 V2206) (shen.lazyderef V2205 V2206) V2206 V2209)) + +(defun bind (V2214 V2215 V2216 V2217 V2218 V2219) (shen.bind! V2214 V2215 V2216 V2219)) + +(defun shen.print-prolog-vector (V2227) "|prolog vector|") + +(defun fork (V2246 V2247 V2248 V2249 V2250) (cond ((= () V2246) false) ((cons? V2246) (let W2251 (((((hd V2246) V2247) V2248) V2249) V2250) (if (= W2251 false) (fork (tl V2246) V2247 V2248 V2249 V2250) W2251))) (true (simple-error "fork expects a list of literals +")))) + +(defun shen.f-error (V5790) (do (pr (cn "partial function " (shen.app V5790 "; +" shen.a)) (stoutput)) (do (if (and (not (shen.tracked? V5790)) (y-or-n? (cn "track " (shen.app V5790 "? " shen.a)))) (shen.track-function (ps V5790)) shen.ok) (simple-error "aborted")))) + +(defun shen.tracked? (V5791) (element? V5791 (value shen.*tracking*))) + +(defun shen.track-function (V5796) (cond ((and (cons? V5796) (and (= defun (hd V5796)) (and (cons? (tl V5796)) (and (cons? (tl (tl V5796))) (and (cons? (tl (tl (tl V5796)))) (= () (tl (tl (tl (tl V5796)))))))))) (let W5797 (cons defun (cons (hd (tl V5796)) (cons (hd (tl (tl V5796))) (cons (shen.insert-tracking-code (hd (tl V5796)) (hd (tl (tl V5796))) (hd (tl (tl (tl V5796))))) ())))) (let W5798 (eval-kl W5797) (let W5799 (set shen.*tracking* (adjoin (hd (tl V5796)) (value shen.*tracking*))) (hd (tl V5796)))))) (true (simple-error "implementation error in shen.track-function")))) + +(defun shen.insert-tracking-code (V5800 V5801 V5802) (cons do (cons (cons set (cons shen.*call* (cons (cons + (cons (cons value (cons shen.*call* ())) (cons 1 ()))) ()))) (cons (cons do (cons (cons shen.input-track (cons (cons value (cons shen.*call* ())) (cons V5800 (cons (shen.cons-form (shen.prolog-track V5802 V5801)) ())))) (cons (cons do (cons (cons shen.terpri-or-read-char ()) (cons (cons let (cons Result (cons V5802 (cons (cons do (cons (cons shen.output-track (cons (cons value (cons shen.*call* ())) (cons V5800 (cons Result ())))) (cons (cons do (cons (cons set (cons shen.*call* (cons (cons - (cons (cons value (cons shen.*call* ())) (cons 1 ()))) ()))) (cons (cons do (cons (cons shen.terpri-or-read-char ()) (cons Result ()))) ()))) ()))) ())))) ()))) ()))) ())))) + +(defun shen.prolog-track (V5803 V5804) (cond ((= (occurrences shen.incinfs V5803) 0) V5804) (true (shen.vector-dereference V5804 (shen.vector-parameter V5804))))) + +(defun shen.vector-parameter (V5807) (cond ((= () V5807) ()) ((and (cons? V5807) (and (cons? (tl V5807)) (and (cons? (tl (tl V5807))) (and (cons? (tl (tl (tl V5807)))) (= () (tl (tl (tl (tl V5807))))))))) (hd V5807)) ((cons? V5807) (shen.vector-parameter (tl V5807))) (true (shen.f-error shen.vector-parameter)))) + +(defun shen.vector-dereference (V5810 V5811) (cond ((= () V5811) V5810) ((and (cons? V5810) (and (cons? (tl V5810)) (and (cons? (tl (tl V5810))) (and (cons? (tl (tl (tl V5810)))) (= () (tl (tl (tl (tl V5810))))))))) V5810) ((cons? V5810) (cons (cons shen.deref (cons (hd V5810) (cons V5811 ()))) (shen.vector-dereference (tl V5810) V5811))) (true (shen.f-error shen.vector-dereference)))) + +(defun shen.terpri-or-read-char () (if (value shen.*step*) (shen.check-byte (read-byte (value *stinput*))) (nl 1))) + +(defun shen.check-byte (V5820) (cond ((= 94 V5820) (simple-error "aborted")) (true true))) + +(defun shen.input-track (V5821 V5822 V5823) (do (pr (cn " +" (shen.app (shen.spaces V5821) (cn "<" (shen.app V5821 (cn "> Inputs to " (shen.app V5822 (cn " +" (shen.app (shen.spaces V5821) "" shen.a)) shen.a)) shen.a)) shen.a)) (stoutput)) (shen.recursively-print V5823))) + +(defun shen.recursively-print (V5826) (cond ((= () V5826) (pr " ==>" (stoutput))) ((cons? V5826) (do (print (hd V5826)) (do (pr ", " (stoutput)) (shen.recursively-print (tl V5826))))) (true (simple-error "implementation error in shen.recursively-print")))) + +(defun shen.spaces (V5827) (cond ((= 0 V5827) "") (true (cn " " (shen.spaces (- V5827 1)))))) + +(defun shen.output-track (V5828 V5829 V5830) (pr (cn " +" (shen.app (shen.spaces V5828) (cn "<" (shen.app V5828 (cn "> Output from " (shen.app V5829 (cn " +" (shen.app (shen.spaces V5828) (cn "==> " (shen.app V5830 "" shen.s)) shen.a)) shen.a)) shen.a)) shen.a)) (stoutput))) + +(defun remove (V5833 V5834) (shen.remove-h V5833 V5834 ())) + +(defun shen.remove-h (V5844 V5845 V5846) (cond ((= () V5845) (reverse V5846)) ((and (cons? V5845) (= V5844 (hd V5845))) (shen.remove-h (hd V5845) (tl V5845) V5846)) ((cons? V5845) (shen.remove-h V5844 (tl V5845) (cons (hd V5845) V5846))) (true (simple-error "implementation error in shen.remove-h")))) + +(defun load (V1239) (let W1240 (value shen.*tc*) (let W1241 (let W1242 (get-time run) (let W1243 (shen.load-help W1240 (read-file V1239)) (let W1244 (get-time run) (let W1245 (- W1244 W1242) (let W1246 (pr (cn " +run time: " (cn (str W1245) " secs +")) (stoutput)) W1243))))) (let W1247 (if W1240 (pr (cn " +typechecked in " (shen.app (inferences) " inferences +" shen.a)) (stoutput)) shen.skip) loaded)))) + +(defun shen.load-help (V1250 V1251) (cond ((= false V1250) (shen.eval-and-print V1251)) (true (shen.check-eval-and-print V1251)))) + +(defun shen.eval-and-print (V1252) (shen.for-each (lambda Z1253 (pr (shen.app (eval-kl (shen.shen->kl Z1253)) " +" shen.s) (stoutput))) V1252)) + +(defun shen.check-eval-and-print (V1254) (let W1255 (mapcan (lambda Z1256 (shen.typetable Z1256)) V1254) (let W1257 (trap-error (shen.assumetypes W1255) (lambda Z1258 (shen.unwind-types Z1258 W1255))) (trap-error (shen.work-through V1254) (lambda Z1259 (shen.unwind-types Z1259 W1255)))))) + +(defun shen.typetable (V1264) (cond ((and (cons? V1264) (and (= define (hd V1264)) (and (cons? (tl V1264)) (and (cons? (tl (tl V1264))) (= { (hd (tl (tl V1264)))))))) (cons (hd (tl V1264)) (cons (shen.rectify-type (shen.type-F (hd (tl V1264)) (tl (tl (tl V1264))))) ()))) ((and (cons? V1264) (and (= define (hd V1264)) (cons? (tl V1264)))) (simple-error (cn "missing { in " (shen.app (hd (tl V1264)) " +" shen.a)))) (true ()))) + +(defun shen.type-F (V1271 V1272) (cond ((and (cons? V1272) (= } (hd V1272))) ()) ((cons? V1272) (cons (hd V1272) (shen.type-F V1271 (tl V1272)))) (true (simple-error (cn "missing } in " (shen.app V1271 " +" shen.a)))))) + +(defun shen.assumetypes (V1275) (cond ((= () V1275) ()) ((and (cons? V1275) (cons? (tl V1275))) (do (declare (hd V1275) (hd (tl V1275))) (shen.assumetypes (tl (tl V1275))))) (true (simple-error "implementation error in shen.assumetype")))) + +(defun shen.unwind-types (V1280 V1281) (cond ((and (cons? V1281) (cons? (tl V1281))) (do (destroy (hd V1281)) (shen.unwind-types V1280 (tl (tl V1281))))) (true (simple-error (error-to-string V1280))))) + +(defun shen.work-through (V1284) (cond ((= () V1284) ()) ((and (cons? V1284) (and (cons? (tl V1284)) (and (cons? (tl (tl V1284))) (= (hd (tl V1284)) (intern ":"))))) (let W1285 (shen.typecheck (hd V1284) (hd (tl (tl V1284)))) (if (= W1285 false) (shen.type-error) (let W1286 (eval-kl (shen.shen->kl (hd V1284))) (let W1287 (pr (shen.app W1286 (cn " : " (shen.app (shen.pretty-type W1285) " +" shen.r)) shen.s) (stoutput)) (shen.work-through (tl (tl (tl V1284))))))))) ((cons? V1284) (shen.work-through (cons (hd V1284) (cons (intern ":") (cons A (tl V1284)))))) (true (simple-error "implementation error in shen.work-through")))) + +(defun shen.pretty-type (V1289) (cond ((and (cons? V1289) (and (cons? (hd V1289)) (and (= list (hd (hd V1289))) (and (cons? (tl (hd V1289))) (and (= () (tl (tl (hd V1289)))) (and (cons? (tl V1289)) (and (= --> (hd (tl V1289))) (and (cons? (tl (tl V1289))) (and (cons? (hd (tl (tl V1289)))) (and (= str (hd (hd (tl (tl V1289))))) (and (cons? (tl (hd (tl (tl V1289))))) (and (cons? (hd (tl (hd (tl (tl V1289)))))) (and (= list (hd (hd (tl (hd (tl (tl V1289))))))) (and (cons? (tl (hd (tl (hd (tl (tl V1289))))))) (and (= () (tl (tl (hd (tl (hd (tl (tl V1289)))))))) (and (cons? (tl (tl (hd (tl (tl V1289)))))) (and (= () (tl (tl (tl (hd (tl (tl V1289))))))) (and (= () (tl (tl (tl V1289)))) (= (hd (tl (hd V1289))) (hd (tl (hd (tl (hd (tl (tl V1289)))))))))))))))))))))))))) (cons (hd (tl (hd (tl (tl V1289))))) (cons ==> (tl (tl (hd (tl (tl V1289)))))))) ((cons? V1289) (map (lambda Z1290 (shen.pretty-type Z1290)) V1289)) (true V1289))) + +(defun shen.type-error () (simple-error "type error +")) + +(defun print (V6803) (let W6804 (shen.insert V6803 "~S") (let W6805 (pr W6804 (stoutput)) V6803))) + +(defun pr (V6806 V6807) (if (value *hush*) V6806 (if (shen.char-stoutput? V6807) (shen.write-string V6806 V6807) (shen.write-chars V6806 V6807 (shen.string->byte V6806 0) 1)))) + +(defun shen.string->byte (V6808 V6809) (trap-error (string->n (pos V6808 V6809)) (lambda Z6810 shen.eos))) + +(defun shen.write-chars (V6811 V6812 V6813 V6814) (cond ((= shen.eos V6813) V6811) (true (shen.write-chars V6811 V6812 (do (write-byte V6813 V6812) (shen.string->byte V6811 V6814)) (+ V6814 1))))) + +(defun shen.mkstr (V6815 V6816) (cond ((string? V6815) (shen.mkstr-l (shen.proc-nl V6815) V6816)) (true (shen.mkstr-r (cons shen.proc-nl (cons V6815 ())) V6816)))) + +(defun shen.mkstr-l (V6821 V6822) (cond ((= () V6822) V6821) ((cons? V6822) (shen.mkstr-l (shen.insert-l (hd V6822) V6821) (tl V6822))) (true (simple-error "implementation error in shen.mkstr-l")))) + +(defun shen.insert-l (V6829 V6830) (cond ((= "" V6830) "") ((and (shen.+string? V6830) (and (= "~" (hdstr V6830)) (and (shen.+string? (tlstr V6830)) (= "A" (hdstr (tlstr V6830)))))) (cons shen.app (cons V6829 (cons (tlstr (tlstr V6830)) (cons shen.a ()))))) ((and (shen.+string? V6830) (and (= "~" (hdstr V6830)) (and (shen.+string? (tlstr V6830)) (= "R" (hdstr (tlstr V6830)))))) (cons shen.app (cons V6829 (cons (tlstr (tlstr V6830)) (cons shen.r ()))))) ((and (shen.+string? V6830) (and (= "~" (hdstr V6830)) (and (shen.+string? (tlstr V6830)) (= "S" (hdstr (tlstr V6830)))))) (cons shen.app (cons V6829 (cons (tlstr (tlstr V6830)) (cons shen.s ()))))) ((shen.+string? V6830) (shen.factor-cn (cons cn (cons (hdstr V6830) (cons (shen.insert-l V6829 (tlstr V6830)) ()))))) ((and (cons? V6830) (and (= cn (hd V6830)) (and (cons? (tl V6830)) (and (cons? (tl (tl V6830))) (= () (tl (tl (tl V6830)))))))) (cons cn (cons (hd (tl V6830)) (cons (shen.insert-l V6829 (hd (tl (tl V6830)))) ())))) ((and (cons? V6830) (and (= shen.app (hd V6830)) (and (cons? (tl V6830)) (and (cons? (tl (tl V6830))) (and (cons? (tl (tl (tl V6830)))) (= () (tl (tl (tl (tl V6830)))))))))) (cons shen.app (cons (hd (tl V6830)) (cons (shen.insert-l V6829 (hd (tl (tl V6830)))) (tl (tl (tl V6830))))))) (true (simple-error "implementation error in shen.insert-l")))) + +(defun shen.factor-cn (V6831) (cond ((and (cons? V6831) (and (= cn (hd V6831)) (and (cons? (tl V6831)) (and (cons? (tl (tl V6831))) (and (cons? (hd (tl (tl V6831)))) (and (= cn (hd (hd (tl (tl V6831))))) (and (cons? (tl (hd (tl (tl V6831))))) (and (cons? (tl (tl (hd (tl (tl V6831)))))) (and (= () (tl (tl (tl (hd (tl (tl V6831))))))) (and (= () (tl (tl (tl V6831)))) (and (string? (hd (tl V6831))) (string? (hd (tl (hd (tl (tl V6831))))))))))))))))) (cons cn (cons (cn (hd (tl V6831)) (hd (tl (hd (tl (tl V6831)))))) (tl (tl (hd (tl (tl V6831)))))))) (true V6831))) + +(defun shen.proc-nl (V6834) (cond ((= "" V6834) "") ((and (shen.+string? V6834) (and (= "~" (hdstr V6834)) (and (shen.+string? (tlstr V6834)) (= "%" (hdstr (tlstr V6834)))))) (cn (n->string 10) (shen.proc-nl (tlstr (tlstr V6834))))) ((shen.+string? V6834) (cn (hdstr V6834) (shen.proc-nl (tlstr V6834)))) (true (simple-error "implementation error in shen.proc-nl")))) + +(defun shen.mkstr-r (V6839 V6840) (cond ((= () V6840) V6839) ((cons? V6840) (shen.mkstr-r (cons shen.insert (cons (hd V6840) (cons V6839 ()))) (tl V6840))) (true (simple-error "implementation error in shen.mkstr-r")))) + +(defun shen.insert (V6841 V6842) (shen.insert-h V6841 V6842 "")) + +(defun shen.insert-h (V6851 V6852 V6853) (cond ((= "" V6852) V6853) ((and (shen.+string? V6852) (and (= "~" (hdstr V6852)) (and (shen.+string? (tlstr V6852)) (= "A" (hdstr (tlstr V6852)))))) (cn V6853 (shen.app V6851 (tlstr (tlstr V6852)) shen.a))) ((and (shen.+string? V6852) (and (= "~" (hdstr V6852)) (and (shen.+string? (tlstr V6852)) (= "R" (hdstr (tlstr V6852)))))) (cn V6853 (shen.app V6851 (tlstr (tlstr V6852)) shen.r))) ((and (shen.+string? V6852) (and (= "~" (hdstr V6852)) (and (shen.+string? (tlstr V6852)) (= "S" (hdstr (tlstr V6852)))))) (cn V6853 (shen.app V6851 (tlstr (tlstr V6852)) shen.s))) ((shen.+string? V6852) (shen.insert-h V6851 (tlstr V6852) (cn V6853 (hdstr V6852)))) (true (simple-error "implementation error in shen.insert-h")))) + +(defun shen.app (V6854 V6855 V6856) (cn (shen.arg->str V6854 V6856) V6855)) + +(defun shen.arg->str (V6860 V6861) (cond ((= V6860 (fail)) "...") ((shen.list? V6860) (shen.list->str V6860 V6861)) ((string? V6860) (shen.str->str V6860 V6861)) ((absvector? V6860) (shen.vector->str V6860 V6861)) (true (shen.atom->str V6860)))) + +(defun shen.list->str (V6862 V6863) (cond ((= shen.r V6863) (@s "(" (@s (shen.iter-list V6862 shen.r (shen.maxseq)) ")"))) (true (@s "[" (@s (shen.iter-list V6862 V6863 (shen.maxseq)) "]"))))) + +(defun shen.maxseq () (value *maximum-print-sequence-size*)) + +(defun shen.iter-list (V6874 V6875 V6876) (cond ((= () V6874) "") ((= 0 V6876) "... etc") ((and (cons? V6874) (= () (tl V6874))) (shen.arg->str (hd V6874) V6875)) ((cons? V6874) (@s (shen.arg->str (hd V6874) V6875) (@s " " (shen.iter-list (tl V6874) V6875 (- V6876 1))))) (true (@s "|" (@s " " (shen.arg->str V6874 V6875)))))) + +(defun shen.str->str (V6879 V6880) (cond ((= shen.a V6880) V6879) (true (@s (n->string 34) (@s V6879 (n->string 34)))))) + +(defun shen.vector->str (V6881 V6882) (if (shen.print-vector? V6881) ((fn (<-address V6881 0)) V6881) (if (vector? V6881) (@s "<" (@s (shen.iter-vector V6881 1 V6882 (shen.maxseq)) ">")) (@s "<" (@s "<" (@s (shen.iter-vector V6881 0 V6882 (shen.maxseq)) ">>")))))) + +(defun shen.empty-absvector? (V6883) (= V6883 (value shen.*empty-absvector*))) + +(defun shen.print-vector? (V6884) (and (not (shen.empty-absvector? V6884)) (let W6885 (<-address V6884 0) (or (= W6885 shen.tuple) (or (= W6885 shen.pvar) (or (= W6885 shen.dictionary) (and (not (number? W6885)) (shen.fbound? W6885)))))))) + +(defun shen.fbound? (V6886) (not (= (arity V6886) -1))) + +(defun shen.tuple (V6887) (cn "(@p " (shen.app (<-address V6887 1) (cn " " (shen.app (<-address V6887 2) ")" shen.s)) shen.s))) + +(defun shen.dictionary (V6888) "(dict ...)") + +(defun shen.iter-vector (V6895 V6896 V6897 V6898) (cond ((= 0 V6898) "... etc") (true (let W6899 (trap-error (<-address V6895 V6896) (lambda Z6900 shen.out-of-bounds)) (let W6901 (trap-error (<-address V6895 (+ V6896 1)) (lambda Z6902 shen.out-of-bounds)) (if (= W6899 shen.out-of-bounds) "" (if (= W6901 shen.out-of-bounds) (shen.arg->str W6899 V6897) (@s (shen.arg->str W6899 V6897) (@s " " (shen.iter-vector V6895 (+ V6896 1) V6897 (- V6898 1))))))))))) + +(defun shen.atom->str (V6903) (trap-error (str V6903) (lambda Z6904 (shen.funexstring)))) + +(defun shen.funexstring () (@s "" (@s "f" (@s "u" (@s "n" (@s "e" (@s (shen.arg->str (gensym (intern "x")) shen.a) ""))))))) + +(defun shen.list? (V6905) (or (empty? V6905) (cons? V6905))) + +(defun macroexpand (V6939) (let W6940 (map (lambda Z6941 (tl Z6941)) (value *macros*)) (shen.macroexpand-h V6939 W6940 W6940))) + +(defun shen.macroexpand-h (V6950 V6951 V6952) (if (= () V6951) V6950 (if (cons? V6951) (let W6953 (shen.walk (hd V6951) V6950) (if (= V6950 W6953) (shen.macroexpand-h V6950 (tl V6951) V6952) (shen.macroexpand-h W6953 V6952 V6952))) (simple-error "implementation error in shen.macroexpand-h")))) + +(defun shen.walk (V6954 V6955) (if (cons? V6955) (V6954 (map (lambda Z6956 (shen.walk V6954 Z6956)) V6955)) (V6954 V6955))) + +(defun shen.macros (V6957) (let GoTo6958 (freeze V6957) (if (cons? V6957) (let Select6963 (hd V6957) (let Select6964 (tl V6957) (if (and (= defmacro Select6963) (cons? Select6964)) (shen.process-def (hd Select6964) (tl Select6964)) (if (= defcc Select6963) (shen.yacc->shen Select6964) (if (and (= u! Select6963) (and (cons? Select6964) (= () (tl Select6964)))) (cons protect (cons (shen.make-uppercase (hd Select6964)) ())) (if (and (= error Select6963) (cons? Select6964)) (cons simple-error (cons (shen.mkstr (hd Select6964) (tl Select6964)) ())) (if (and (= output Select6963) (cons? Select6964)) (cons pr (cons (shen.mkstr (hd Select6964) (tl Select6964)) (cons (cons stoutput ()) ()))) (if (and (= pr Select6963) (and (cons? Select6964) (= () (tl Select6964)))) (cons pr (cons (hd Select6964) (cons (cons stoutput ()) ()))) (if (and (= make-string Select6963) (cons? Select6964)) (shen.mkstr (hd Select6964) (tl Select6964)) (if (and (= lineread Select6963) (= () Select6964)) (cons lineread (cons (cons stinput ()) ())) (if (and (= input Select6963) (= () Select6964)) (cons input (cons (cons stinput ()) ())) (if (and (= read Select6963) (= () Select6964)) (cons read (cons (cons stinput ()) ())) (if (and (= input+ Select6963) (and (cons? Select6964) (= () (tl Select6964)))) (cons input+ (cons (hd Select6964) (cons (cons stinput ()) ()))) (if (and (= read-byte Select6963) (= () Select6964)) (shen.process-read-byte) (if (= prolog? Select6963) (shen.call-prolog Select6964) (if (and (= defprolog Select6963) (cons? Select6964)) (shen.compile-prolog (hd Select6964) (tl Select6964)) (if (and (= datatype Select6963) (cons? Select6964)) (shen.process-datatype (hd Select6964) (tl Select6964)) (if (= @s Select6963) (shen.process-@s V6957) (if (= synonyms Select6963) (shen.process-synonyms Select6964) (if (and (= nl Select6963) (= () Select6964)) (cons nl (cons 1 ())) (if (= let Select6963) (shen.process-let V6957) (if (= /. Select6963) (shen.process-lambda V6957) (if (= cases Select6963) (shen.process-cases V6957) (if (and (= time Select6963) (and (cons? Select6964) (= () (tl Select6964)))) (shen.process-time (hd Select6964)) (if (and (= put Select6963) (and (cons? Select6964) (and (cons? (tl Select6964)) (and (cons? (tl (tl Select6964))) (= () (tl (tl (tl Select6964)))))))) (cons put (cons (hd Select6964) (cons (hd (tl Select6964)) (cons (hd (tl (tl Select6964))) (cons (cons value (cons *property-vector* ())) ()))))) (if (and (= get Select6963) (and (cons? Select6964) (and (cons? (tl Select6964)) (= () (tl (tl Select6964)))))) (cons get (cons (hd Select6964) (cons (hd (tl Select6964)) (cons (cons value (cons *property-vector* ())) ())))) (if (and (= unput Select6963) (and (cons? Select6964) (and (cons? (tl Select6964)) (= () (tl (tl Select6964)))))) (cons unput (cons (hd Select6964) (cons (hd (tl Select6964)) (cons (cons value (cons *property-vector* ())) ())))) (if (and (= shen.@c Select6963) (and (cons? Select6964) (= () (tl Select6964)))) (shen.rcons_form (hd Select6964)) (let GoTo6959 (freeze (if (and (cons? Select6964) (and (cons? (tl Select6964)) (and (cons? (tl (tl Select6964))) (element? Select6963 (cons @p (cons @v (cons append (cons and (cons or (cons + (cons * (cons do ())))))))))))) (cons Select6963 (cons (hd Select6964) (cons (shen.process-assoc (cons Select6963 (tl Select6964))) ()))) (thaw GoTo6958))) (if (= shen.@ch Select6963) (if (cons? Select6964) (let Select6961 (hd Select6964) (let Select6962 (tl Select6964) (if (and (cons? Select6961) (and (cons? (tl Select6961)) (and (cons? (tl (tl Select6961))) (and (= () (tl (tl (tl Select6961)))) (and (= () Select6962) (= (hd (tl Select6961)) (intern ":"))))))) (shen.cons-form-respect-modes (cons - (cons (cons (hd Select6961) (cons (hd (tl Select6961)) (cons (cons + (tl (tl Select6961))) ()))) ()))) (if (= () Select6962) (shen.cons-form-respect-modes Select6961) (thaw GoTo6959))))) (thaw GoTo6959)) (thaw GoTo6959))))))))))))))))))))))))))))))) (thaw GoTo6958)))) + +(defun shen.cons-form-respect-modes (V6965) (let GoTo6966 (freeze V6965) (if (cons? V6965) (let Select6967 (hd V6965) (let Select6968 (tl V6965) (if (and (= + Select6967) (and (cons? Select6968) (= () (tl Select6968)))) (cons + (cons (shen.cons-form-respect-modes (hd Select6968)) ())) (if (and (= - Select6967) (and (cons? Select6968) (= () (tl Select6968)))) (cons - (cons (shen.cons-form-respect-modes (hd Select6968)) ())) (cons cons (cons (shen.cons-form-respect-modes Select6967) (cons (shen.cons-form-respect-modes Select6968) ()))))))) (thaw GoTo6966)))) + +(defun shen.process-def (V6969 V6970) (let W6971 (cons X (cons -> (cons X ()))) (let W6972 (eval (cons define (cons V6969 (append V6970 W6971)))) (let W6973 (shen.record-macro V6969 (fn V6969)) V6969)))) + +(defun shen.process-let (V6974) (if (and (cons? V6974) (and (= let (hd V6974)) (and (cons? (tl V6974)) (and (cons? (tl (tl V6974))) (and (cons? (tl (tl (tl V6974)))) (cons? (tl (tl (tl (tl V6974)))))))))) (cons let (cons (hd (tl V6974)) (cons (hd (tl (tl V6974))) (cons (cons let (tl (tl (tl V6974)))) ())))) V6974)) + +(defun shen.process-@s (V6975) (let GoTo6977 (freeze V6975) (if (cons? V6975) (let Select6984 (tl V6975) (if (= @s (hd V6975)) (if (cons? Select6984) (let Select6982 (hd Select6984) (let Select6983 (tl Select6984) (if (cons? Select6983) (let Select6981 (tl Select6983) (if (cons? Select6981) (cons @s (cons Select6982 (cons (shen.process-@s (cons @s Select6983)) ()))) (if (and (= () Select6981) (string? Select6982)) (let W6976 (explode Select6982) (if (> (length W6976) 1) (shen.process-@s (cons @s (append W6976 Select6983))) V6975)) (thaw GoTo6977)))) (thaw GoTo6977)))) (thaw GoTo6977)) (thaw GoTo6977))) (thaw GoTo6977)))) + +(defun shen.process-datatype (V6985 V6986) (let W6987 (shen.intern-type V6985) (let W6988 (compile (lambda Z6989 (shen. Z6989)) (cons W6987 V6986)) W6987))) + +(defun shen.intern-type (V6990) (intern (cn (str V6990) "#type"))) + +(defun shen.process-synonyms (V6991) (shen.synonyms-h (set shen.*synonyms* (append V6991 (value shen.*synonyms*))))) + +(defun shen.lambda-of-defun (V6994) (if (and (cons? V6994) (and (= defun (hd V6994)) (and (cons? (tl V6994)) (and (cons? (tl (tl V6994))) (and (cons? (hd (tl (tl V6994)))) (and (= () (tl (hd (tl (tl V6994))))) (and (cons? (tl (tl (tl V6994)))) (= () (tl (tl (tl (tl V6994)))))))))))) (eval (cons /. (cons (hd (hd (tl (tl V6994)))) (tl (tl (tl V6994)))))) (shen.f-error shen.lambda-of-defun))) + +(defun shen.synonyms-h (V6995) (let W6996 (map (lambda Z6997 (shen.curry-type Z6997)) V6995) (let W6998 (shen.lambda-of-defun (shen.shendef->kldef shen.demod (shen.compile-synonyms W6996))) (let W6999 (set shen.*demodulation-function* W6998) synonyms)))) + +(defun shen.compile-synonyms (V7002) (if (= () V7002) (let W7003 (gensym X) (cons W7003 (cons -> (cons W7003 ())))) (if (and (cons? V7002) (cons? (tl V7002))) (cons (shen.rcons_form (hd V7002)) (cons -> (cons (shen.rcons_form (hd (tl V7002))) (shen.compile-synonyms (tl (tl V7002)))))) (simple-error "synonyms requires an even number of arguments +")))) + +(defun shen.process-lambda (V7004) (let GoTo7005 (freeze V7004) (if (cons? V7004) (let Select7012 (tl V7004) (if (= /. (hd V7004)) (if (cons? Select7012) (let Select7010 (hd Select7012) (let Select7011 (tl Select7012) (if (cons? Select7011) (let Select7009 (tl Select7011) (if (cons? Select7009) (cons lambda (cons Select7010 (cons (shen.process-lambda (cons /. Select7011)) ()))) (if (= () Select7009) (if (variable? Select7010) (cons lambda Select7012) (simple-error (shen.app Select7010 " is not a variable +" shen.s))) (thaw GoTo7005)))) (thaw GoTo7005)))) (thaw GoTo7005)) (thaw GoTo7005))) (thaw GoTo7005)))) + +(defun shen.process-cases (V7015) (let GoTo7016 (freeze V7015) (if (cons? V7015) (let Select7024 (tl V7015) (if (= cases (hd V7015)) (if (cons? Select7024) (let Select7022 (hd Select7024) (let Select7023 (tl Select7024) (if (and (= true Select7022) (cons? Select7023)) (hd Select7023) (let GoTo7019 (freeze (if (= () Select7023) (simple-error "error: odd number of case elements +") (thaw GoTo7016))) (if (cons? Select7023) (let Select7020 (hd Select7023) (let Select7021 (tl Select7023) (if (= () Select7021) (cons if (cons Select7022 (cons Select7020 (cons (cons simple-error (cons "error: cases exhausted" ())) ())))) (cons if (cons Select7022 (cons Select7020 (cons (shen.process-cases (cons cases Select7021)) ()))))))) (thaw GoTo7019)))))) (thaw GoTo7016)) (thaw GoTo7016))) (thaw GoTo7016)))) + +(defun shen.process-time (V7025) (cons let (cons Start (cons (cons get-time (cons run ())) (cons Result (cons V7025 (cons Finish (cons (cons get-time (cons run ())) (cons Time (cons (cons - (cons Finish (cons Start ()))) (cons Message (cons (cons pr (cons (cons cn (cons " +run time: " (cons (cons cn (cons (cons str (cons Time ())) (cons " secs +" ()))) ()))) (cons (cons stoutput ()) ()))) (cons Result ()))))))))))))) + +(defun shen.process-assoc (V7026) (if (and (cons? V7026) (and (cons? (tl V7026)) (and (cons? (tl (tl V7026))) (cons? (tl (tl (tl V7026))))))) (cons (hd V7026) (cons (hd (tl V7026)) (cons (cons (hd V7026) (tl (tl V7026))) ()))) V7026)) + +(defun shen.make-uppercase (V7027) (intern (shen.mu-h (str V7027)))) + +(defun shen.mu-h (V7028) (if (= "" V7028) "" (if (shen.+string? V7028) (let W7029 (string->n (hdstr V7028)) (let W7030 (- W7029 32) (let W7031 (if (and (>= W7029 97) (<= W7029 122)) (n->string W7030) (hdstr V7028)) (@s W7031 (shen.mu-h (tlstr V7028)))))) (shen.f-error shen.mu-h)))) + +(defun shen.record-macro (V7032 V7033) (set *macros* (shen.update-assoc V7032 V7033 (value *macros*)))) + +(defun shen.update-assoc (V7043 V7044 V7045) (if (= () V7045) (cons (cons V7043 V7044) ()) (let GoTo7046 (freeze (simple-error "implementation error in shen.update-assoc")) (if (cons? V7045) (let Select7047 (hd V7045) (let Select7048 (tl V7045) (if (and (cons? Select7047) (= V7043 (hd Select7047))) (cons (cons (hd Select7047) V7044) Select7048) (cons Select7047 (shen.update-assoc V7043 V7044 Select7048))))) (thaw GoTo7046))))) + +(defun shen.process-read-byte () (if (shen.char-stinput? (stinput)) (cons string->n (cons (cons shen.read-unit-string (cons (cons stinput ()) ())) ())) (cons read-byte (cons (cons stinput ()) ())))) + +(defun shen.call-prolog (V7049) (let W7050 (cons shen.prolog-vector ()) (let W7051 (cons @v (cons true (cons 0 (cons (cons vector (cons 0 ())) ())))) (let W7052 0 (let W7053 (cons freeze (cons true ())) (let W7054 (compile (lambda Z7055 (shen. Z7055)) V7049) (let W7056 (shen.received V7049) (let W7057 (gensym V) (let W7058 (gensym L) (let W7059 (gensym K) (let W7060 (gensym C) (let W7061 (cons lambda (cons W7057 (cons (cons lambda (cons W7058 (cons (cons lambda (cons W7059 (cons (cons lambda (cons W7060 (cons (shen.continue W7056 W7054 W7057 W7058 W7059 W7060) ()))) ()))) ()))) ()))) (cons W7061 (cons W7050 (cons W7051 (cons W7052 (cons W7053 ()))))))))))))))))) + +(defun shen.received (V7064) (let GoTo7065 (freeze ()) (if (cons? V7064) (let Select7066 (hd V7064) (let Select7067 (tl V7064) (if (and (= receive Select7066) (and (cons? Select7067) (= () (tl Select7067)))) Select7067 (union (shen.received Select7066) (shen.received Select7067))))) (thaw GoTo7065)))) + +(defun shen.prolog-vector () (let W7068 (absvector (value shen.*prolog-memory*)) (let W7069 (address-> W7068 0 shen.print-prolog-vector) (let W7070 (address-> W7068 1 2) W7070)))) + +(defun receive (V7071) V7071) + +(defun shen.rcons_form (V7072) (if (cons? V7072) (cons cons (cons (shen.rcons_form (hd V7072)) (cons (shen.rcons_form (tl V7072)) ()))) V7072)) + +(defun prolog-memory (V910) (if (< V910 0) (value shen.*prolog-memory*) (if (integer? V910) (set shen.*prolog-memory* V910) (simple-error "prolog memory expects an integer value +")))) + +(defun arity (V911) (trap-error (get V911 arity (value *property-vector*)) (lambda Z912 -1))) + +(defun shen.initialise-arity-table (V915) (cond ((= () V915) ()) ((and (cons? V915) (cons? (tl V915))) (let W916 (put (hd V915) arity (hd (tl V915)) (value *property-vector*)) (shen.initialise-arity-table (tl (tl V915))))) (true (simple-error "implementation error in shen.initialise-arity-table")))) + +(defun adjoin (V920 V921) (if (element? V920 V921) V921 (cons V920 V921))) + +(defun shen.set-lambda-form-entry (V924) (cond ((cons? V924) (put (hd V924) shen.lambda-form (tl V924) (value *property-vector*))) (true (shen.f-error shen.set-lambda-form-entry)))) + +(defun declare (V5907 V5908) (let W5909 (shen.rectify-type V5908) (let W5910 (((((lambda Z5911 (lambda Z5912 (lambda Z5913 (lambda Z5914 (do (shen.incinfs) (shen.variancy (receive (shen.deref V5907 Z5911)) (receive (shen.deref W5909 Z5911)) Z5911 Z5912 Z5913 Z5914)))))) (shen.prolog-vector)) (@v true (@v 0 (vector 0)))) 0) (freeze true)) (let W5915 (eval-kl (shen.prolog-abstraction V5908)) (let W5916 (set shen.*sigf* (shen.assoc-> V5907 W5915 (value shen.*sigf*))) V5907))))) + +(defun shen.variancy (V5917 V5918 V5919 V5920 V5921 V5922) (if (shen.unlocked? V5920) (let W5923 (shen.newpv V5919) (shen.gc V5919 (do (shen.incinfs) (shen.system-S-h V5917 W5923 () V5919 V5920 V5921 (freeze (shen.variants? V5917 W5923 V5918 V5919 V5920 V5921 V5922)))))) false)) + +(defun shen.variants? (V5924 V5925 V5926 V5927 V5928 V5929 V5930) (let W5931 (+ V5929 1) (let W5932 (if (shen.unlocked? V5928) (let W5933 (shen.lazyderef V5925 V5927) (let W5934 (freeze (do (shen.incinfs) (shen.cut V5927 V5928 W5931 V5930))) (if (= W5933 symbol) (thaw W5934) (if (shen.pvar? W5933) (shen.bind! W5933 symbol V5927 W5934) false)))) false) (if (= W5932 false) (let W5935 (if (shen.unlocked? V5928) (do (shen.incinfs) (is! V5925 V5926 V5927 V5928 W5931 V5930)) false) (if (= W5935 false) (let W5936 (if (shen.unlocked? V5928) (let W5937 (shen.newpv V5927) (shen.gc V5927 (do (shen.incinfs) (is W5937 (pr (cn "warning: changing the type of " (shen.app (shen.deref V5924 V5927) " may create errors +" shen.a)) (stoutput)) V5927 V5928 W5931 V5930)))) false) (if (= W5936 false) (shen.unlock V5928 W5931) W5936)) W5935)) W5932)))) + +(defun shen.prolog-abstraction (V5938) (let W5939 (gensym B) (let W5940 (gensym L) (let W5941 (gensym Key) (let W5942 (gensym C) (let W5943 (gensym V) (let W5944 (shen.extract-vars V5938) (cons lambda (cons W5943 (cons (cons lambda (cons W5939 (cons (cons lambda (cons W5940 (cons (cons lambda (cons W5941 (cons (cons lambda (cons W5942 (cons (shen.stpart W5944 (cons is! (cons W5943 (cons (shen.rcons_form V5938) (cons W5939 (cons W5940 (cons W5941 (cons W5942 ()))))))) W5939) ()))) ()))) ()))) ()))) ())))))))))) + +(defun shen.demod (V5945) (let W5946 (value shen.*demodulation-function*) (W5946 V5945))) + +(defun shen.typecheck (V4853 V4854) (let W4855 (shen.extract-vars V4854) (let W4856 (shen.rectify-type V4854) (let W4857 (shen.curry V4853) (((((lambda Z4858 (lambda Z4859 (lambda Z4860 (lambda Z4861 (let W4862 (shen.newpv Z4858) (shen.gc Z4858 (do (shen.incinfs) (shen.insert-prolog-variables (receive (shen.deref W4855 Z4858)) (receive (shen.deref W4856 Z4858)) W4862 Z4858 Z4859 Z4860 (freeze (shen.toplevel-forms (receive (shen.deref W4857 Z4858)) W4862 Z4858 Z4859 Z4860 (freeze (return W4862 Z4858 Z4859 Z4860 Z4861)))))))))))) (shen.prolog-vector)) (@v true (@v 0 (vector 0)))) 0) (freeze true)))))) + +(defun shen.insert-prolog-variables (V4863 V4864 V4865 V4866 V4867 V4868 V4869) (let W4870 (if (shen.unlocked? V4867) (let W4871 (shen.lazyderef V4863 V4866) (if (= W4871 ()) (do (shen.incinfs) (is! V4864 V4865 V4866 V4867 V4868 V4869)) false)) false) (if (= W4870 false) (if (shen.unlocked? V4867) (let W4872 (shen.lazyderef V4863 V4866) (if (cons? W4872) (let W4873 (hd W4872) (let W4874 (tl W4872) (let W4875 (shen.newpv V4866) (shen.gc V4866 (do (shen.incinfs) (shen.insert-prolog-variables W4874 (subst (shen.deref W4875 V4866) W4873 V4864) V4865 V4866 V4867 V4868 V4869)))))) false)) false) W4870))) + +(defun shen.toplevel-forms (V4876 V4877 V4878 V4879 V4880 V4881) (let W4882 (+ V4880 1) (let W4883 (if (shen.unlocked? V4879) (let W4884 (shen.lazyderef V4876 V4878) (if (cons? W4884) (let W4885 (shen.lazyderef (hd W4884) V4878) (if (= W4885 define) (let W4886 (shen.lazyderef (tl W4884) V4878) (if (cons? W4886) (let W4887 (hd W4886) (let W4888 (tl W4886) (do (shen.incinfs) (when (shen.type-theory-enabled?) V4878 V4879 W4882 (freeze (shen.cut V4878 V4879 W4882 (freeze (shen.signal-def (value shen.*spy*) W4887 V4878 V4879 W4882 (freeze (shen.t* (cons define (cons W4887 W4888)) V4877 V4878 V4879 W4882 V4881)))))))))) false)) false)) false)) false) (if (= W4883 false) (let W4889 (if (shen.unlocked? V4879) (do (shen.incinfs) (shen.system-S (cons V4876 (cons (intern ":") (cons V4877 ()))) () V4878 V4879 W4882 V4881)) false) (if (= W4889 false) (shen.unlock V4879 W4882) W4889)) W4883)))) + +(defun shen.signal-def (V4890 V4891 V4892 V4893 V4894 V4895) (let W4896 (if (shen.unlocked? V4893) (let W4897 (shen.lazyderef V4890 V4892) (if (= W4897 false) (do (shen.incinfs) (thaw V4895)) false)) false) (if (= W4896 false) (if (shen.unlocked? V4893) (let W4898 (shen.lazyderef V4890 V4892) (if (= W4898 true) (let W4899 (shen.newpv V4892) (shen.gc V4892 (do (shen.incinfs) (is W4899 (pr (cn " +typechecking (fn " (shen.app (shen.deref V4891 V4892) ") +" shen.a)) (stoutput)) V4892 V4893 V4894 V4895)))) false)) false) W4896))) + +(defun shen.rectify-type (V4900) (shen.demodulate (shen.curry-type V4900))) + +(defun shen.demodulate (V4901) (trap-error (let W4902 (shen.walk (lambda Z4903 (shen.demod Z4903)) V4901) (if (= W4902 V4901) V4901 (shen.demodulate W4902))) (lambda Z4904 V4901))) + +(defun shen.curry-type (V4905) (cond ((and (cons? V4905) (and (cons? (tl V4905)) (and (= --> (hd (tl V4905))) (and (cons? (tl (tl V4905))) (and (cons? (tl (tl (tl V4905)))) (= --> (hd (tl (tl (tl V4905)))))))))) (shen.curry-type (cons (hd V4905) (cons --> (cons (tl (tl V4905)) ()))))) ((and (cons? V4905) (and (cons? (hd V4905)) (and (= list (hd (hd V4905))) (and (cons? (tl (hd V4905))) (and (= () (tl (tl (hd V4905)))) (and (cons? (tl V4905)) (and (= ==> (hd (tl V4905))) (and (cons? (tl (tl V4905))) (= () (tl (tl (tl V4905)))))))))))) (shen.curry-type (cons (hd V4905) (cons --> (cons (cons str (cons (hd V4905) (tl (tl V4905)))) ()))))) ((and (cons? V4905) (and (cons? (tl V4905)) (and (= * (hd (tl V4905))) (and (cons? (tl (tl V4905))) (and (cons? (tl (tl (tl V4905)))) (= * (hd (tl (tl (tl V4905)))))))))) (shen.curry-type (cons (hd V4905) (cons * (cons (tl (tl V4905)) ()))))) ((cons? V4905) (map (lambda Z4906 (shen.curry-type Z4906)) V4905)) (true V4905))) + +(defun shen.curry (V4907) (cond ((and (cons? V4907) (and (= define (hd V4907)) (cons? (tl V4907)))) V4907) ((and (cons? V4907) (and (= type (hd V4907)) (and (cons? (tl V4907)) (and (cons? (tl (tl V4907))) (= () (tl (tl (tl V4907)))))))) (cons type (cons (shen.curry (hd (tl V4907))) (tl (tl V4907))))) ((and (cons? V4907) (and (= input+ (hd V4907)) (and (cons? (tl V4907)) (and (cons? (tl (tl V4907))) (= () (tl (tl (tl V4907)))))))) (cons input+ (cons (hd (tl V4907)) (cons (shen.curry (hd (tl (tl V4907)))) ())))) ((and (cons? V4907) (shen.special? (hd V4907))) (cons (hd V4907) (map (lambda Z4908 (shen.curry Z4908)) (tl V4907)))) ((and (cons? V4907) (shen.extraspecial? (hd V4907))) V4907) ((and (cons? V4907) (and (cons? (tl V4907)) (cons? (tl (tl V4907))))) (shen.curry (cons (cons (hd V4907) (cons (hd (tl V4907)) ())) (tl (tl V4907))))) ((and (cons? V4907) (and (cons? (tl V4907)) (= () (tl (tl V4907))))) (cons (shen.curry (hd V4907)) (cons (shen.curry (hd (tl V4907))) ()))) (true V4907))) + +(defun shen.special? (V4909) (element? V4909 (value shen.*special*))) + +(defun shen.extraspecial? (V4910) (element? V4910 (value shen.*extraspecial*))) + +(defun shen.system-S (V4911 V4912 V4913 V4914 V4915 V4916) (let W4917 (+ V4915 1) (let W4918 (if (shen.unlocked? V4914) (do (shen.incinfs) (when (shen.maxinfexceeded?) V4913 V4914 W4917 V4916)) false) (if (= W4918 false) (let W4919 (if (shen.unlocked? V4914) (let W4920 (shen.lazyderef V4911 V4913) (if (cons? W4920) (let W4921 (hd W4920) (let W4922 (shen.lazyderef (tl W4920) V4913) (if (cons? W4922) (let W4923 (hd W4922) (let W4924 (shen.lazyderef (tl W4922) V4913) (if (cons? W4924) (let W4925 (hd W4924) (let W4926 (shen.lazyderef (tl W4924) V4913) (if (= W4926 ()) (do (shen.incinfs) (when (= (shen.deref W4923 V4913) (intern ":")) V4913 V4914 W4917 (freeze (when (shen.type-theory-enabled?) V4913 V4914 W4917 (freeze (shen.cut V4913 V4914 W4917 (freeze (shen.system-S-h W4921 W4925 V4912 V4913 V4914 W4917 V4916)))))))) false))) false))) false))) false)) false) (if (= W4919 false) (let W4927 (if (shen.unlocked? V4914) (do (shen.incinfs) (when (value shen.*spy*) V4913 V4914 W4917 (freeze (shen.show V4911 V4912 V4913 V4914 W4917 V4916)))) false) (if (= W4927 false) (let W4928 (if (shen.unlocked? V4914) (do (shen.incinfs) (shen.search-user-datatypes V4911 V4912 (value shen.*datatypes*) V4913 V4914 W4917 V4916)) false) (if (= W4928 false) (shen.unlock V4914 W4917) W4928)) W4927)) W4919)) W4918)))) + +(defun shen.show (V4935 V4936 V4937 V4938 V4939 V4940) (do (shen.line) (do (shen.show-p (shen.deref V4935 V4937)) (do (nl 2) (do (shen.show-assumptions (shen.deref V4936 V4937) 1) (do (shen.pause-for-user) false)))))) + +(defun shen.line () (let W4941 (inferences) (pr (cn "____________________________________________________________ " (shen.app W4941 (cn " inference" (shen.app (if (= 1 W4941) "" "s") " +?- " shen.a)) shen.a)) (stoutput)))) + +(defun shen.show-p (V4942) (cond ((and (cons? V4942) (and (cons? (tl V4942)) (and (cons? (tl (tl V4942))) (and (= () (tl (tl (tl V4942)))) (= (hd (tl V4942)) (intern ":")))))) (do (shen.prterm (hd V4942)) (do (pr " : " (stoutput)) (pr (shen.app (hd (tl (tl V4942))) "" shen.r) (stoutput))))) (true (shen.prterm V4942)))) + +(defun shen.prterm (V4943) (cond ((and (cons? V4943) (and (= cons (hd V4943)) (and (cons? (tl V4943)) (and (cons? (tl (tl V4943))) (= () (tl (tl (tl V4943)))))))) (do (pr "[" (stoutput)) (do (shen.prterm (hd (tl V4943))) (do (shen.prtl (hd (tl (tl V4943)))) (pr "]" (stoutput)))))) ((cons? V4943) (do (pr "(" (stoutput)) (do (shen.prterm (hd V4943)) (do (map (lambda Z4944 (do (pr " " (stoutput)) (shen.prterm Z4944))) (tl V4943)) (pr ")" (stoutput)))))) (true (print V4943)))) + +(defun shen.prtl (V4945) (cond ((= () V4945) "") ((and (cons? V4945) (and (= cons (hd V4945)) (and (cons? (tl V4945)) (and (cons? (tl (tl V4945))) (= () (tl (tl (tl V4945)))))))) (do (pr " " (stoutput)) (do (shen.prterm (hd (tl V4945))) (shen.prtl (hd (tl (tl V4945))))))) (true (do (pr " | " (stoutput)) (shen.prterm V4945))))) + +(defun shen.show-assumptions (V4952 V4953) (cond ((= () V4952) (pr " +> " (stoutput))) ((cons? V4952) (do (pr (shen.app V4953 ". " shen.a) (stoutput)) (do (shen.show-p (hd V4952)) (do (nl 1) (shen.show-assumptions (tl V4952) (+ V4953 1)))))) (true (simple-error "implementation error in shen.show-assumptions")))) + +(defun shen.pause-for-user () (let W4954 (read-byte (stinput)) (if (= W4954 94) (simple-error "input aborted +") (nl 1)))) + +(defun shen.type-theory-enabled? () (value shen.*shen-type-theory-enabled?*)) + +(defun shen.maxinfexceeded? () (if (> (inferences) (value shen.*maxinferences*)) (simple-error "maximum inferences exceeded") false)) + +(defun shen.system-S-h (V4955 V4956 V4957 V4958 V4959 V4960 V4961) (let W4962 (+ V4960 1) (let W4963 (if (shen.unlocked? V4959) (do (shen.incinfs) (when (value shen.*spy*) V4958 V4959 W4962 (freeze (shen.show (cons V4955 (cons (intern ":") (cons V4956 ()))) V4957 V4958 V4959 W4962 V4961)))) false) (if (= W4963 false) (let W4964 (if (shen.unlocked? V4959) (do (shen.incinfs) (when (not (cons? (shen.lazyderef V4955 V4958))) V4958 V4959 W4962 (freeze (shen.primitive V4955 V4956 V4958 V4959 W4962 V4961)))) false) (if (= W4964 false) (let W4965 (if (shen.unlocked? V4959) (do (shen.incinfs) (shen.by-hypothesis V4955 V4956 V4957 V4958 V4959 W4962 V4961)) false) (if (= W4965 false) (let W4966 (if (shen.unlocked? V4959) (let W4967 (shen.lazyderef V4955 V4958) (if (cons? W4967) (let W4968 (hd W4967) (let W4969 (shen.lazyderef (tl W4967) V4958) (if (= W4969 ()) (do (shen.incinfs) (shen.lookupsig W4968 (cons --> (cons V4956 ())) V4958 V4959 W4962 V4961)) false))) false)) false) (if (= W4966 false) (let W4970 (if (shen.unlocked? V4959) (let W4971 (shen.lazyderef V4955 V4958) (if (cons? W4971) (let W4972 (shen.lazyderef (hd W4971) V4958) (if (= W4972 fn) (let W4973 (shen.lazyderef (tl W4971) V4958) (if (cons? W4973) (let W4974 (hd W4973) (let W4975 (shen.lazyderef (tl W4973) V4958) (if (= W4975 ()) (do (shen.incinfs) (when (= (arity (shen.deref W4974 V4958)) 0) V4958 V4959 W4962 (freeze (shen.cut V4958 V4959 W4962 (freeze (shen.system-S-h (cons W4974 ()) V4956 V4957 V4958 V4959 W4962 V4961)))))) false))) false)) false)) false)) false) (if (= W4970 false) (let W4976 (if (shen.unlocked? V4959) (let W4977 (shen.lazyderef V4955 V4958) (if (cons? W4977) (let W4978 (shen.lazyderef (hd W4977) V4958) (if (= W4978 fn) (let W4979 (shen.lazyderef (tl W4977) V4958) (if (cons? W4979) (let W4980 (hd W4979) (let W4981 (shen.lazyderef (tl W4979) V4958) (if (= W4981 ()) (do (shen.incinfs) (shen.lookupsig W4980 V4956 V4958 V4959 W4962 V4961)) false))) false)) false)) false)) false) (if (= W4976 false) (let W4982 (if (shen.unlocked? V4959) (let W4983 (shen.lazyderef V4955 V4958) (if (cons? W4983) (let W4984 (hd W4983) (let W4985 (shen.lazyderef (tl W4983) V4958) (if (cons? W4985) (let W4986 (hd W4985) (let W4987 (shen.lazyderef (tl W4985) V4958) (if (= W4987 ()) (let W4988 (shen.newpv V4958) (shen.gc V4958 (do (shen.incinfs) (when (not (cons? (shen.lazyderef W4984 V4958))) V4958 V4959 W4962 (freeze (shen.lookupsig W4984 (cons W4988 (cons --> (cons V4956 ()))) V4958 V4959 W4962 (freeze (shen.system-S-h W4986 W4988 V4957 V4958 V4959 W4962 V4961)))))))) false))) false))) false)) false) (if (= W4982 false) (let W4989 (if (shen.unlocked? V4959) (let W4990 (shen.lazyderef V4955 V4958) (if (cons? W4990) (let W4991 (hd W4990) (let W4992 (shen.lazyderef (tl W4990) V4958) (if (cons? W4992) (let W4993 (hd W4992) (let W4994 (shen.lazyderef (tl W4992) V4958) (if (= W4994 ()) (let W4995 (shen.newpv V4958) (shen.gc V4958 (do (shen.incinfs) (shen.system-S-h W4991 (cons W4995 (cons --> (cons V4956 ()))) V4957 V4958 V4959 W4962 (freeze (shen.system-S-h W4993 W4995 V4957 V4958 V4959 W4962 V4961)))))) false))) false))) false)) false) (if (= W4989 false) (let W4996 (if (shen.unlocked? V4959) (let W4997 (shen.lazyderef V4955 V4958) (if (cons? W4997) (let W4998 (shen.lazyderef (hd W4997) V4958) (if (= W4998 cons) (let W4999 (shen.lazyderef (tl W4997) V4958) (if (cons? W4999) (let W5000 (hd W4999) (let W5001 (shen.lazyderef (tl W4999) V4958) (if (cons? W5001) (let W5002 (hd W5001) (let W5003 (shen.lazyderef (tl W5001) V4958) (if (= W5003 ()) (let W5004 (shen.lazyderef V4956 V4958) (let W5005 (lambda Z5006 (do (shen.incinfs) (shen.system-S-h W5000 Z5006 V4957 V4958 V4959 W4962 (freeze (shen.system-S-h W5002 (cons list (cons Z5006 ())) V4957 V4958 V4959 W4962 V4961))))) (if (cons? W5004) (let W5007 (shen.lazyderef (hd W5004) V4958) (let W5008 (freeze (let W5009 (shen.lazyderef (tl W5004) V4958) (let W5010 (lambda Z5011 (W5005 Z5011)) (if (cons? W5009) (let W5012 (hd W5009) (let W5013 (shen.lazyderef (tl W5009) V4958) (let W5014 (freeze (W5010 W5012)) (if (= W5013 ()) (thaw W5014) (if (shen.pvar? W5013) (shen.bind! W5013 () V4958 W5014) false))))) (if (shen.pvar? W5009) (let W5015 (shen.newpv V4958) (shen.gc V4958 (shen.bind! W5009 (cons W5015 ()) V4958 (freeze (W5010 W5015))))) false))))) (if (= W5007 list) (thaw W5008) (if (shen.pvar? W5007) (shen.bind! W5007 list V4958 W5008) false)))) (if (shen.pvar? W5004) (let W5016 (shen.newpv V4958) (shen.gc V4958 (shen.bind! W5004 (cons list (cons W5016 ())) V4958 (freeze (W5005 W5016))))) false)))) false))) false))) false)) false)) false)) false) (if (= W4996 false) (let W5017 (if (shen.unlocked? V4959) (let W5018 (shen.lazyderef V4955 V4958) (if (cons? W5018) (let W5019 (shen.lazyderef (hd W5018) V4958) (if (= W5019 @p) (let W5020 (shen.lazyderef (tl W5018) V4958) (if (cons? W5020) (let W5021 (hd W5020) (let W5022 (shen.lazyderef (tl W5020) V4958) (if (cons? W5022) (let W5023 (hd W5022) (let W5024 (shen.lazyderef (tl W5022) V4958) (if (= W5024 ()) (let W5025 (shen.lazyderef V4956 V4958) (let W5026 (lambda Z5027 (lambda Z5028 (do (shen.incinfs) (shen.system-S-h W5021 Z5027 V4957 V4958 V4959 W4962 (freeze (shen.system-S-h W5023 Z5028 V4957 V4958 V4959 W4962 V4961)))))) (if (cons? W5025) (let W5029 (hd W5025) (let W5030 (shen.lazyderef (tl W5025) V4958) (let W5031 (lambda Z5032 ((W5026 W5029) Z5032)) (if (cons? W5030) (let W5033 (shen.lazyderef (hd W5030) V4958) (let W5034 (freeze (let W5035 (shen.lazyderef (tl W5030) V4958) (let W5036 (lambda Z5037 (W5031 Z5037)) (if (cons? W5035) (let W5038 (hd W5035) (let W5039 (shen.lazyderef (tl W5035) V4958) (let W5040 (freeze (W5036 W5038)) (if (= W5039 ()) (thaw W5040) (if (shen.pvar? W5039) (shen.bind! W5039 () V4958 W5040) false))))) (if (shen.pvar? W5035) (let W5041 (shen.newpv V4958) (shen.gc V4958 (shen.bind! W5035 (cons W5041 ()) V4958 (freeze (W5036 W5041))))) false))))) (if (= W5033 *) (thaw W5034) (if (shen.pvar? W5033) (shen.bind! W5033 * V4958 W5034) false)))) (if (shen.pvar? W5030) (let W5042 (shen.newpv V4958) (shen.gc V4958 (shen.bind! W5030 (cons * (cons W5042 ())) V4958 (freeze (W5031 W5042))))) false))))) (if (shen.pvar? W5025) (let W5043 (shen.newpv V4958) (shen.gc V4958 (let W5044 (shen.newpv V4958) (shen.gc V4958 (shen.bind! W5025 (cons W5043 (cons * (cons W5044 ()))) V4958 (freeze ((W5026 W5043) W5044))))))) false)))) false))) false))) false)) false)) false)) false) (if (= W5017 false) (let W5045 (if (shen.unlocked? V4959) (let W5046 (shen.lazyderef V4955 V4958) (if (cons? W5046) (let W5047 (shen.lazyderef (hd W5046) V4958) (if (= W5047 @v) (let W5048 (shen.lazyderef (tl W5046) V4958) (if (cons? W5048) (let W5049 (hd W5048) (let W5050 (shen.lazyderef (tl W5048) V4958) (if (cons? W5050) (let W5051 (hd W5050) (let W5052 (shen.lazyderef (tl W5050) V4958) (if (= W5052 ()) (let W5053 (shen.lazyderef V4956 V4958) (let W5054 (lambda Z5055 (do (shen.incinfs) (shen.system-S-h W5049 Z5055 V4957 V4958 V4959 W4962 (freeze (shen.system-S-h W5051 (cons vector (cons Z5055 ())) V4957 V4958 V4959 W4962 V4961))))) (if (cons? W5053) (let W5056 (shen.lazyderef (hd W5053) V4958) (let W5057 (freeze (let W5058 (shen.lazyderef (tl W5053) V4958) (let W5059 (lambda Z5060 (W5054 Z5060)) (if (cons? W5058) (let W5061 (hd W5058) (let W5062 (shen.lazyderef (tl W5058) V4958) (let W5063 (freeze (W5059 W5061)) (if (= W5062 ()) (thaw W5063) (if (shen.pvar? W5062) (shen.bind! W5062 () V4958 W5063) false))))) (if (shen.pvar? W5058) (let W5064 (shen.newpv V4958) (shen.gc V4958 (shen.bind! W5058 (cons W5064 ()) V4958 (freeze (W5059 W5064))))) false))))) (if (= W5056 vector) (thaw W5057) (if (shen.pvar? W5056) (shen.bind! W5056 vector V4958 W5057) false)))) (if (shen.pvar? W5053) (let W5065 (shen.newpv V4958) (shen.gc V4958 (shen.bind! W5053 (cons vector (cons W5065 ())) V4958 (freeze (W5054 W5065))))) false)))) false))) false))) false)) false)) false)) false) (if (= W5045 false) (let W5066 (if (shen.unlocked? V4959) (let W5067 (shen.lazyderef V4955 V4958) (if (cons? W5067) (let W5068 (shen.lazyderef (hd W5067) V4958) (if (= W5068 @s) (let W5069 (shen.lazyderef (tl W5067) V4958) (if (cons? W5069) (let W5070 (hd W5069) (let W5071 (shen.lazyderef (tl W5069) V4958) (if (cons? W5071) (let W5072 (hd W5071) (let W5073 (shen.lazyderef (tl W5071) V4958) (if (= W5073 ()) (let W5074 (shen.lazyderef V4956 V4958) (let W5075 (freeze (do (shen.incinfs) (shen.system-S-h W5070 string V4957 V4958 V4959 W4962 (freeze (shen.system-S-h W5072 string V4957 V4958 V4959 W4962 V4961))))) (if (= W5074 string) (thaw W5075) (if (shen.pvar? W5074) (shen.bind! W5074 string V4958 W5075) false)))) false))) false))) false)) false)) false)) false) (if (= W5066 false) (let W5076 (if (shen.unlocked? V4959) (let W5077 (shen.lazyderef V4955 V4958) (if (cons? W5077) (let W5078 (shen.lazyderef (hd W5077) V4958) (if (= W5078 lambda) (let W5079 (shen.lazyderef (tl W5077) V4958) (if (cons? W5079) (let W5080 (hd W5079) (let W5081 (shen.lazyderef (tl W5079) V4958) (if (cons? W5081) (let W5082 (hd W5081) (let W5083 (shen.lazyderef (tl W5081) V4958) (if (= W5083 ()) (let W5084 (shen.lazyderef V4956 V4958) (let W5085 (lambda Z5086 (lambda Z5087 (let W5088 (shen.newpv V4958) (shen.gc V4958 (let W5089 (shen.newpv V4958) (shen.gc V4958 (do (shen.incinfs) (bind W5089 (shen.freshterm (shen.lazyderef W5080 V4958)) V4958 V4959 W4962 (freeze (bind W5088 (shen.beta (shen.lazyderef W5080 V4958) (shen.deref W5089 V4958) (shen.deref W5082 V4958)) V4958 V4959 W4962 (freeze (shen.system-S-h W5088 Z5087 (cons (cons W5089 (cons (intern ":") (cons Z5086 ()))) V4957) V4958 V4959 W4962 V4961)))))))))))) (if (cons? W5084) (let W5090 (hd W5084) (let W5091 (shen.lazyderef (tl W5084) V4958) (let W5092 (lambda Z5093 ((W5085 W5090) Z5093)) (if (cons? W5091) (let W5094 (shen.lazyderef (hd W5091) V4958) (let W5095 (freeze (let W5096 (shen.lazyderef (tl W5091) V4958) (let W5097 (lambda Z5098 (W5092 Z5098)) (if (cons? W5096) (let W5099 (hd W5096) (let W5100 (shen.lazyderef (tl W5096) V4958) (let W5101 (freeze (W5097 W5099)) (if (= W5100 ()) (thaw W5101) (if (shen.pvar? W5100) (shen.bind! W5100 () V4958 W5101) false))))) (if (shen.pvar? W5096) (let W5102 (shen.newpv V4958) (shen.gc V4958 (shen.bind! W5096 (cons W5102 ()) V4958 (freeze (W5097 W5102))))) false))))) (if (= W5094 -->) (thaw W5095) (if (shen.pvar? W5094) (shen.bind! W5094 --> V4958 W5095) false)))) (if (shen.pvar? W5091) (let W5103 (shen.newpv V4958) (shen.gc V4958 (shen.bind! W5091 (cons --> (cons W5103 ())) V4958 (freeze (W5092 W5103))))) false))))) (if (shen.pvar? W5084) (let W5104 (shen.newpv V4958) (shen.gc V4958 (let W5105 (shen.newpv V4958) (shen.gc V4958 (shen.bind! W5084 (cons W5104 (cons --> (cons W5105 ()))) V4958 (freeze ((W5085 W5104) W5105))))))) false)))) false))) false))) false)) false)) false)) false) (if (= W5076 false) (let W5106 (if (shen.unlocked? V4959) (let W5107 (shen.lazyderef V4955 V4958) (if (cons? W5107) (let W5108 (shen.lazyderef (hd W5107) V4958) (if (= W5108 let) (let W5109 (shen.lazyderef (tl W5107) V4958) (if (cons? W5109) (let W5110 (hd W5109) (let W5111 (shen.lazyderef (tl W5109) V4958) (if (cons? W5111) (let W5112 (hd W5111) (let W5113 (shen.lazyderef (tl W5111) V4958) (if (cons? W5113) (let W5114 (hd W5113) (let W5115 (shen.lazyderef (tl W5113) V4958) (if (= W5115 ()) (let W5116 (shen.newpv V4958) (shen.gc V4958 (let W5117 (shen.newpv V4958) (shen.gc V4958 (let W5118 (shen.newpv V4958) (shen.gc V4958 (do (shen.incinfs) (shen.system-S-h W5112 W5118 V4957 V4958 V4959 W4962 (freeze (bind W5117 (shen.freshterm (shen.lazyderef W5110 V4958)) V4958 V4959 W4962 (freeze (bind W5116 (shen.beta (shen.lazyderef W5110 V4958) (shen.lazyderef W5117 V4958) (shen.lazyderef W5114 V4958)) V4958 V4959 W4962 (freeze (shen.system-S-h W5116 V4956 (cons (cons W5117 (cons (intern ":") (cons W5118 ()))) V4957) V4958 V4959 W4962 V4961)))))))))))))) false))) false))) false))) false)) false)) false)) false) (if (= W5106 false) (let W5119 (if (shen.unlocked? V4959) (let W5120 (shen.lazyderef V4955 V4958) (if (cons? W5120) (let W5121 (shen.lazyderef (hd W5120) V4958) (if (= W5121 open) (let W5122 (shen.lazyderef (tl W5120) V4958) (if (cons? W5122) (let W5123 (hd W5122) (let W5124 (shen.lazyderef (tl W5122) V4958) (if (cons? W5124) (let W5125 (hd W5124) (let W5126 (shen.lazyderef (tl W5124) V4958) (if (= W5126 ()) (let W5127 (shen.lazyderef V4956 V4958) (let W5128 (lambda Z5129 (do (shen.incinfs) (is! W5125 Z5129 V4958 V4959 W4962 (freeze (when (element? (shen.lazyderef Z5129 V4958) (cons in (cons out ()))) V4958 V4959 W4962 (freeze (shen.system-S-h W5123 string V4957 V4958 V4959 W4962 V4961))))))) (if (cons? W5127) (let W5130 (shen.lazyderef (hd W5127) V4958) (let W5131 (freeze (let W5132 (shen.lazyderef (tl W5127) V4958) (let W5133 (lambda Z5134 (W5128 Z5134)) (if (cons? W5132) (let W5135 (hd W5132) (let W5136 (shen.lazyderef (tl W5132) V4958) (let W5137 (freeze (W5133 W5135)) (if (= W5136 ()) (thaw W5137) (if (shen.pvar? W5136) (shen.bind! W5136 () V4958 W5137) false))))) (if (shen.pvar? W5132) (let W5138 (shen.newpv V4958) (shen.gc V4958 (shen.bind! W5132 (cons W5138 ()) V4958 (freeze (W5133 W5138))))) false))))) (if (= W5130 stream) (thaw W5131) (if (shen.pvar? W5130) (shen.bind! W5130 stream V4958 W5131) false)))) (if (shen.pvar? W5127) (let W5139 (shen.newpv V4958) (shen.gc V4958 (shen.bind! W5127 (cons stream (cons W5139 ())) V4958 (freeze (W5128 W5139))))) false)))) false))) false))) false)) false)) false)) false) (if (= W5119 false) (let W5140 (if (shen.unlocked? V4959) (let W5141 (shen.lazyderef V4955 V4958) (if (cons? W5141) (let W5142 (shen.lazyderef (hd W5141) V4958) (if (= W5142 type) (let W5143 (shen.lazyderef (tl W5141) V4958) (if (cons? W5143) (let W5144 (hd W5143) (let W5145 (shen.lazyderef (tl W5143) V4958) (if (cons? W5145) (let W5146 (hd W5145) (let W5147 (shen.lazyderef (tl W5145) V4958) (if (= W5147 ()) (do (shen.incinfs) (shen.cut V4958 V4959 W4962 (freeze (is! (shen.rectify-type (shen.deref W5146 V4958)) V4956 V4958 V4959 W4962 (freeze (shen.system-S-h W5144 V4956 V4957 V4958 V4959 W4962 V4961)))))) false))) false))) false)) false)) false)) false) (if (= W5140 false) (let W5148 (if (shen.unlocked? V4959) (let W5149 (shen.lazyderef V4955 V4958) (if (cons? W5149) (let W5150 (shen.lazyderef (hd W5149) V4958) (if (= W5150 input+) (let W5151 (shen.lazyderef (tl W5149) V4958) (if (cons? W5151) (let W5152 (hd W5151) (let W5153 (shen.lazyderef (tl W5151) V4958) (if (cons? W5153) (let W5154 (hd W5153) (let W5155 (shen.lazyderef (tl W5153) V4958) (if (= W5155 ()) (do (shen.incinfs) (is! V4956 (shen.rectify-type (shen.deref W5152 V4958)) V4958 V4959 W4962 (freeze (shen.system-S-h W5154 (cons stream (cons in ())) V4957 V4958 V4959 W4962 V4961)))) false))) false))) false)) false)) false)) false) (if (= W5148 false) (let W5156 (if (shen.unlocked? V4959) (let W5157 (shen.lazyderef V4955 V4958) (if (cons? W5157) (let W5158 (shen.lazyderef (hd W5157) V4958) (if (= W5158 set) (let W5159 (shen.lazyderef (tl W5157) V4958) (if (cons? W5159) (let W5160 (hd W5159) (let W5161 (shen.lazyderef (tl W5159) V4958) (if (cons? W5161) (let W5162 (hd W5161) (let W5163 (shen.lazyderef (tl W5161) V4958) (if (= W5163 ()) (do (shen.incinfs) (shen.system-S-h W5160 symbol V4957 V4958 V4959 W4962 (freeze (shen.system-S-h (cons value (cons W5160 ())) V4956 V4957 V4958 V4959 W4962 (freeze (shen.system-S-h W5162 V4956 V4957 V4958 V4959 W4962 V4961)))))) false))) false))) false)) false)) false)) false) (if (= W5156 false) (let W5164 (if (shen.unlocked? V4959) (let W5165 (shen.newpv V4958) (shen.gc V4958 (do (shen.incinfs) (shen.l-rules V4957 W5165 false V4958 V4959 W4962 (freeze (shen.cut V4958 V4959 W4962 (freeze (shen.system-S-h V4955 V4956 W5165 V4958 V4959 W4962 V4961)))))))) false) (if (= W5164 false) (let W5166 (if (shen.unlocked? V4959) (do (shen.incinfs) (shen.search-user-datatypes (cons V4955 (cons (intern ":") (cons V4956 ()))) V4957 (value shen.*datatypes*) V4958 V4959 W4962 V4961)) false) (if (= W5166 false) (shen.unlock V4959 W4962) W5166)) W5164)) W5156)) W5148)) W5140)) W5119)) W5106)) W5076)) W5066)) W5045)) W5017)) W4996)) W4989)) W4982)) W4976)) W4970)) W4966)) W4965)) W4964)) W4963)))) + +(defun shen.primitive (V5167 V5168 V5169 V5170 V5171 V5172) (let W5173 (if (shen.unlocked? V5170) (let W5174 (shen.lazyderef V5168 V5169) (let W5175 (freeze (do (shen.incinfs) (when (number? (shen.lazyderef V5167 V5169)) V5169 V5170 V5171 V5172))) (if (= W5174 number) (thaw W5175) (if (shen.pvar? W5174) (shen.bind! W5174 number V5169 W5175) false)))) false) (if (= W5173 false) (let W5176 (if (shen.unlocked? V5170) (let W5177 (shen.lazyderef V5168 V5169) (let W5178 (freeze (do (shen.incinfs) (when (boolean? (shen.lazyderef V5167 V5169)) V5169 V5170 V5171 V5172))) (if (= W5177 boolean) (thaw W5178) (if (shen.pvar? W5177) (shen.bind! W5177 boolean V5169 W5178) false)))) false) (if (= W5176 false) (let W5179 (if (shen.unlocked? V5170) (let W5180 (shen.lazyderef V5168 V5169) (let W5181 (freeze (do (shen.incinfs) (when (string? (shen.lazyderef V5167 V5169)) V5169 V5170 V5171 V5172))) (if (= W5180 string) (thaw W5181) (if (shen.pvar? W5180) (shen.bind! W5180 string V5169 W5181) false)))) false) (if (= W5179 false) (let W5182 (if (shen.unlocked? V5170) (let W5183 (shen.lazyderef V5168 V5169) (let W5184 (freeze (do (shen.incinfs) (when (symbol? (shen.lazyderef V5167 V5169)) V5169 V5170 V5171 V5172))) (if (= W5183 symbol) (thaw W5184) (if (shen.pvar? W5183) (shen.bind! W5183 symbol V5169 W5184) false)))) false) (if (= W5182 false) (if (shen.unlocked? V5170) (let W5185 (shen.lazyderef V5167 V5169) (if (= W5185 ()) (let W5186 (shen.lazyderef V5168 V5169) (let W5187 (lambda Z5188 (do (shen.incinfs) (thaw V5172))) (if (cons? W5186) (let W5189 (shen.lazyderef (hd W5186) V5169) (let W5190 (freeze (let W5191 (shen.lazyderef (tl W5186) V5169) (let W5192 (lambda Z5193 (W5187 Z5193)) (if (cons? W5191) (let W5194 (hd W5191) (let W5195 (shen.lazyderef (tl W5191) V5169) (let W5196 (freeze (W5192 W5194)) (if (= W5195 ()) (thaw W5196) (if (shen.pvar? W5195) (shen.bind! W5195 () V5169 W5196) false))))) (if (shen.pvar? W5191) (let W5197 (shen.newpv V5169) (shen.gc V5169 (shen.bind! W5191 (cons W5197 ()) V5169 (freeze (W5192 W5197))))) false))))) (if (= W5189 list) (thaw W5190) (if (shen.pvar? W5189) (shen.bind! W5189 list V5169 W5190) false)))) (if (shen.pvar? W5186) (let W5198 (shen.newpv V5169) (shen.gc V5169 (shen.bind! W5186 (cons list (cons W5198 ())) V5169 (freeze (W5187 W5198))))) false)))) false)) false) W5182)) W5179)) W5176)) W5173))) + +(defun shen.by-hypothesis (V5199 V5200 V5201 V5202 V5203 V5204 V5205) (let W5206 (if (shen.unlocked? V5203) (let W5207 (shen.lazyderef V5201 V5202) (if (cons? W5207) (let W5208 (shen.lazyderef (hd W5207) V5202) (if (cons? W5208) (let W5209 (hd W5208) (let W5210 (shen.lazyderef (tl W5208) V5202) (if (cons? W5210) (let W5211 (hd W5210) (let W5212 (shen.lazyderef (tl W5210) V5202) (if (cons? W5212) (let W5213 (hd W5212) (let W5214 (shen.lazyderef (tl W5212) V5202) (if (= W5214 ()) (do (shen.incinfs) (when (= (shen.deref W5211 V5202) (intern ":")) V5202 V5203 V5204 (freeze (when (= (shen.deref V5199 V5202) (shen.deref W5209 V5202)) V5202 V5203 V5204 (freeze (is! V5200 W5213 V5202 V5203 V5204 V5205)))))) false))) false))) false))) false)) false)) false) (if (= W5206 false) (if (shen.unlocked? V5203) (let W5215 (shen.lazyderef V5201 V5202) (if (cons? W5215) (let W5216 (tl W5215) (do (shen.incinfs) (shen.by-hypothesis V5199 V5200 W5216 V5202 V5203 V5204 V5205))) false)) false) W5206))) + +(defun shen.lookupsig (V5217 V5218 V5219 V5220 V5221 V5222) (if (shen.unlocked? V5220) (do (shen.incinfs) (shen.sigf (assoc V5217 (value shen.*sigf*)) V5218 V5219 V5220 V5221 V5222)) false)) + +(defun shen.sigf (V5237 V5238 V5239 V5240 V5241 V5242) (cond ((cons? V5237) ((((((tl V5237) V5238) V5239) V5240) V5241) V5242)) (true false))) + +(defun shen.freshterm (V5243) (let W5244 (absvector 3) (let W5245 (address-> W5244 0 shen.print-freshterm) (let W5246 (address-> W5245 1 V5243) (let W5247 (address-> W5246 2 (set shen.*gensym* (+ 1 (value shen.*gensym*)))) W5247))))) + +(defun shen.print-freshterm (V5248) (cn "&&" (str (<-address V5248 1)))) + +(defun shen.search-user-datatypes (V5249 V5250 V5251 V5252 V5253 V5254 V5255) (let W5256 (if (shen.unlocked? V5253) (let W5257 (shen.lazyderef V5251 V5252) (if (cons? W5257) (let W5258 (shen.lazyderef (hd W5257) V5252) (if (cons? W5258) (let W5259 (tl W5258) (do (shen.incinfs) (call (((shen.deref W5259 V5252) (shen.deref V5249 V5252)) (shen.deref V5250 V5252)) V5252 V5253 V5254 V5255))) false)) false)) false) (if (= W5256 false) (if (shen.unlocked? V5253) (let W5260 (shen.lazyderef V5251 V5252) (if (cons? W5260) (let W5261 (tl W5260) (do (shen.incinfs) (shen.search-user-datatypes V5249 V5250 W5261 V5252 V5253 V5254 V5255))) false)) false) W5256))) + +(defun shen.l-rules (V5262 V5263 V5264 V5265 V5266 V5267 V5268) (let W5269 (+ V5267 1) (let W5270 (if (shen.unlocked? V5266) (let W5271 (shen.lazyderef V5262 V5265) (if (= W5271 ()) (let W5272 (shen.lazyderef V5264 V5265) (if (= W5272 true) (do (shen.incinfs) (shen.cut V5265 V5266 W5269 (freeze (bind V5263 () V5265 V5266 W5269 V5268)))) false)) false)) false) (if (= W5270 false) (let W5273 (if (shen.unlocked? V5266) (let W5274 (shen.lazyderef V5262 V5265) (if (cons? W5274) (let W5275 (shen.lazyderef (hd W5274) V5265) (if (cons? W5275) (let W5276 (shen.lazyderef (hd W5275) V5265) (if (cons? W5276) (let W5277 (shen.lazyderef (hd W5276) V5265) (if (= W5277 cons) (let W5278 (shen.lazyderef (tl W5276) V5265) (if (cons? W5278) (let W5279 (hd W5278) (let W5280 (shen.lazyderef (tl W5278) V5265) (if (cons? W5280) (let W5281 (hd W5280) (let W5282 (shen.lazyderef (tl W5280) V5265) (if (= W5282 ()) (let W5283 (shen.lazyderef (tl W5275) V5265) (if (cons? W5283) (let W5284 (hd W5283) (let W5285 (shen.lazyderef (tl W5283) V5265) (if (cons? W5285) (let W5286 (shen.lazyderef (hd W5285) V5265) (if (cons? W5286) (let W5287 (shen.lazyderef (hd W5286) V5265) (if (= W5287 list) (let W5288 (shen.lazyderef (tl W5286) V5265) (if (cons? W5288) (let W5289 (hd W5288) (let W5290 (shen.lazyderef (tl W5288) V5265) (if (= W5290 ()) (let W5291 (shen.lazyderef (tl W5285) V5265) (if (= W5291 ()) (let W5292 (tl W5274) (do (shen.incinfs) (when (= (shen.deref W5284 V5265) (intern ":")) V5265 V5266 W5269 (freeze (shen.cut V5265 V5266 W5269 (freeze (shen.l-rules (cons (cons W5279 (cons W5284 (cons W5289 ()))) (cons (cons W5281 (cons W5284 (cons (cons list (cons W5289 ())) ()))) W5292)) V5263 true V5265 V5266 W5269 V5268))))))) false)) false))) false)) false)) false)) false))) false)) false))) false))) false)) false)) false)) false)) false)) false) (if (= W5273 false) (let W5293 (if (shen.unlocked? V5266) (let W5294 (shen.lazyderef V5262 V5265) (if (cons? W5294) (let W5295 (shen.lazyderef (hd W5294) V5265) (if (cons? W5295) (let W5296 (shen.lazyderef (hd W5295) V5265) (if (cons? W5296) (let W5297 (shen.lazyderef (hd W5296) V5265) (if (= W5297 @p) (let W5298 (shen.lazyderef (tl W5296) V5265) (if (cons? W5298) (let W5299 (hd W5298) (let W5300 (shen.lazyderef (tl W5298) V5265) (if (cons? W5300) (let W5301 (hd W5300) (let W5302 (shen.lazyderef (tl W5300) V5265) (if (= W5302 ()) (let W5303 (shen.lazyderef (tl W5295) V5265) (if (cons? W5303) (let W5304 (hd W5303) (let W5305 (shen.lazyderef (tl W5303) V5265) (if (cons? W5305) (let W5306 (shen.lazyderef (hd W5305) V5265) (if (cons? W5306) (let W5307 (hd W5306) (let W5308 (shen.lazyderef (tl W5306) V5265) (if (cons? W5308) (let W5309 (shen.lazyderef (hd W5308) V5265) (if (= W5309 *) (let W5310 (shen.lazyderef (tl W5308) V5265) (if (cons? W5310) (let W5311 (hd W5310) (let W5312 (shen.lazyderef (tl W5310) V5265) (if (= W5312 ()) (let W5313 (shen.lazyderef (tl W5305) V5265) (if (= W5313 ()) (let W5314 (tl W5294) (do (shen.incinfs) (when (= (shen.deref W5304 V5265) (intern ":")) V5265 V5266 W5269 (freeze (shen.cut V5265 V5266 W5269 (freeze (shen.l-rules (cons (cons W5299 (cons W5304 (cons W5307 ()))) (cons (cons W5301 (cons W5304 (cons W5311 ()))) W5314)) V5263 true V5265 V5266 W5269 V5268))))))) false)) false))) false)) false)) false))) false)) false))) false)) false))) false))) false)) false)) false)) false)) false)) false) (if (= W5293 false) (let W5315 (if (shen.unlocked? V5266) (let W5316 (shen.lazyderef V5262 V5265) (if (cons? W5316) (let W5317 (shen.lazyderef (hd W5316) V5265) (if (cons? W5317) (let W5318 (shen.lazyderef (hd W5317) V5265) (if (cons? W5318) (let W5319 (shen.lazyderef (hd W5318) V5265) (if (= W5319 @s) (let W5320 (shen.lazyderef (tl W5318) V5265) (if (cons? W5320) (let W5321 (hd W5320) (let W5322 (shen.lazyderef (tl W5320) V5265) (if (cons? W5322) (let W5323 (hd W5322) (let W5324 (shen.lazyderef (tl W5322) V5265) (if (= W5324 ()) (let W5325 (shen.lazyderef (tl W5317) V5265) (if (cons? W5325) (let W5326 (hd W5325) (let W5327 (shen.lazyderef (tl W5325) V5265) (if (cons? W5327) (let W5328 (shen.lazyderef (hd W5327) V5265) (if (= W5328 string) (let W5329 (shen.lazyderef (tl W5327) V5265) (if (= W5329 ()) (let W5330 (tl W5316) (do (shen.incinfs) (when (= (shen.deref W5326 V5265) (intern ":")) V5265 V5266 W5269 (freeze (shen.cut V5265 V5266 W5269 (freeze (shen.l-rules (cons (cons W5321 (cons W5326 (cons string ()))) (cons (cons W5323 (cons W5326 (cons string ()))) W5330)) V5263 true V5265 V5266 W5269 V5268))))))) false)) false)) false))) false)) false))) false))) false)) false)) false)) false)) false)) false) (if (= W5315 false) (let W5331 (if (shen.unlocked? V5266) (let W5332 (shen.lazyderef V5262 V5265) (if (cons? W5332) (let W5333 (shen.lazyderef (hd W5332) V5265) (if (cons? W5333) (let W5334 (shen.lazyderef (hd W5333) V5265) (if (cons? W5334) (let W5335 (shen.lazyderef (hd W5334) V5265) (if (= W5335 @v) (let W5336 (shen.lazyderef (tl W5334) V5265) (if (cons? W5336) (let W5337 (hd W5336) (let W5338 (shen.lazyderef (tl W5336) V5265) (if (cons? W5338) (let W5339 (hd W5338) (let W5340 (shen.lazyderef (tl W5338) V5265) (if (= W5340 ()) (let W5341 (shen.lazyderef (tl W5333) V5265) (if (cons? W5341) (let W5342 (hd W5341) (let W5343 (shen.lazyderef (tl W5341) V5265) (if (cons? W5343) (let W5344 (shen.lazyderef (hd W5343) V5265) (if (cons? W5344) (let W5345 (shen.lazyderef (hd W5344) V5265) (if (= W5345 vector) (let W5346 (shen.lazyderef (tl W5344) V5265) (if (cons? W5346) (let W5347 (hd W5346) (let W5348 (shen.lazyderef (tl W5346) V5265) (if (= W5348 ()) (let W5349 (shen.lazyderef (tl W5343) V5265) (if (= W5349 ()) (let W5350 (tl W5332) (do (shen.incinfs) (when (= (shen.deref W5342 V5265) (intern ":")) V5265 V5266 W5269 (freeze (shen.cut V5265 V5266 W5269 (freeze (shen.l-rules (cons (cons W5337 (cons W5342 (cons W5347 ()))) (cons (cons W5339 (cons W5342 (cons (cons vector (cons W5347 ())) ()))) W5350)) V5263 true V5265 V5266 W5269 V5268))))))) false)) false))) false)) false)) false)) false))) false)) false))) false))) false)) false)) false)) false)) false)) false) (if (= W5331 false) (let W5351 (if (shen.unlocked? V5266) (let W5352 (shen.lazyderef V5262 V5265) (if (cons? W5352) (let W5353 (hd W5352) (let W5354 (tl W5352) (let W5355 (shen.lazyderef V5263 V5265) (let W5356 (lambda Z5357 (lambda Z5358 (do (shen.incinfs) (bind Z5357 W5353 V5265 V5266 W5269 (freeze (shen.l-rules W5354 Z5358 V5264 V5265 V5266 W5269 V5268)))))) (if (cons? W5355) (let W5359 (hd W5355) (let W5360 (tl W5355) ((W5356 W5359) W5360))) (if (shen.pvar? W5355) (let W5361 (shen.newpv V5265) (shen.gc V5265 (let W5362 (shen.newpv V5265) (shen.gc V5265 (shen.bind! W5355 (cons W5361 W5362) V5265 (freeze ((W5356 W5361) W5362))))))) false)))))) false)) false) (if (= W5351 false) (shen.unlock V5266 W5269) W5351)) W5331)) W5315)) W5293)) W5273)) W5270)))) + +(defun shen.t* (V5363 V5364 V5365 V5366 V5367 V5368) (let W5369 (+ V5367 1) (let W5370 (if (shen.unlocked? V5366) (let W5371 (shen.lazyderef V5363 V5365) (if (cons? W5371) (let W5372 (shen.lazyderef (hd W5371) V5365) (if (= W5372 define) (let W5373 (shen.lazyderef (tl W5371) V5365) (if (cons? W5373) (let W5374 (hd W5373) (let W5375 (tl W5373) (let W5376 (shen.newpv V5365) (shen.gc V5365 (let W5377 (shen.newpv V5365) (shen.gc V5365 (let W5378 (shen.newpv V5365) (shen.gc V5365 (let W5379 (shen.newpv V5365) (shen.gc V5365 (do (shen.incinfs) (shen.cut V5365 V5366 W5369 (freeze (bind W5376 (shen.sigxrules (cons W5374 W5375)) V5365 V5366 W5369 (freeze (bind W5379 (fst (shen.lazyderef W5376 V5365)) V5365 V5366 W5369 (freeze (bind W5377 (snd (shen.lazyderef W5376 V5365)) V5365 V5366 W5369 (freeze (bind W5378 (shen.freshen-sig (shen.deref W5379 V5365)) V5365 V5366 W5369 (freeze (shen.t*-rules W5374 W5377 W5378 1 V5365 V5366 W5369 (freeze (is W5379 V5364 V5365 V5366 W5369 V5368)))))))))))))))))))))))) false)) false)) false)) false) (if (= W5370 false) (shen.unlock V5366 W5369) W5370)))) + +(defun shen.sigxrules (V5380) (compile (lambda Z5381 (shen. Z5381)) V5380)) + +(defun shen. (V5382) (let W5383 (if (cons? V5382) (let W5384 (tail V5382) (if (shen.hds=? W5384 {) (let W5385 (tail W5384) (let W5386 (shen. W5385) (if (shen.parse-failure? W5386) (shen.parse-failure) (let W5387 (shen.<-out W5386) (let W5388 (shen.in-> W5386) (if (shen.hds=? W5388 }) (let W5389 (tail W5388) (let W5390 (shen. W5389) (if (shen.parse-failure? W5390) (shen.parse-failure) (let W5391 (shen.<-out W5390) (let W5392 (shen.in-> W5390) (shen.comb W5392 (let W5393 (shen.rectify-type W5387) (@p W5393 W5391)))))))) (shen.parse-failure))))))) (shen.parse-failure))) (shen.parse-failure)) (if (shen.parse-failure? W5383) (shen.parse-failure) W5383))) + +(defun shen.freshen-sig (V5394) (let W5395 (shen.extract-vars V5394) (let W5396 (map (lambda Z5397 (cons Z5397 (shen.freshterm (concat & Z5397)))) W5395) (shen.freshen-type W5396 V5394)))) + +(defun shen.freshen-type (V5398 V5399) (cond ((= () V5398) V5399) ((and (cons? V5398) (cons? (hd V5398))) (shen.freshen-type (tl V5398) (subst (tl (hd V5398)) (hd (hd V5398)) V5399))) (true (shen.f-error shen.freshen-type)))) + +(defun shen. (V5400) (let W5401 (let W5402 (shen. V5400) (if (shen.parse-failure? W5402) (shen.parse-failure) (let W5403 (shen.<-out W5402) (let W5404 (shen.in-> W5402) (let W5405 (shen. W5404) (if (shen.parse-failure? W5405) (shen.parse-failure) (let W5406 (shen.<-out W5405) (let W5407 (shen.in-> W5405) (shen.comb W5407 (cons W5403 W5406)))))))))) (if (shen.parse-failure? W5401) (let W5408 (let W5409 (shen. V5400) (if (shen.parse-failure? W5409) (shen.parse-failure) (let W5410 (shen.<-out W5409) (let W5411 (shen.in-> W5409) (shen.comb W5411 (cons W5410 ())))))) (if (shen.parse-failure? W5408) (shen.parse-failure) W5408)) W5401))) + +(defun shen. (V5412) (let W5413 (let W5414 (shen. V5412) (if (shen.parse-failure? W5414) (shen.parse-failure) (let W5415 (shen.<-out W5414) (let W5416 (shen.in-> W5414) (if (shen.hds=? W5416 ->) (let W5417 (tail W5416) (if (cons? W5417) (let W5418 (head W5417) (let W5419 (tail W5417) (if (shen.hds=? W5419 where) (let W5420 (tail W5419) (if (cons? W5420) (let W5421 (head W5420) (let W5422 (tail W5420) (shen.comb W5422 (@p W5415 (cons where (cons W5421 (cons W5418 ()))))))) (shen.parse-failure))) (shen.parse-failure)))) (shen.parse-failure))) (shen.parse-failure)))))) (if (shen.parse-failure? W5413) (let W5423 (let W5424 (shen. V5412) (if (shen.parse-failure? W5424) (shen.parse-failure) (let W5425 (shen.<-out W5424) (let W5426 (shen.in-> W5424) (if (shen.hds=? W5426 <-) (let W5427 (tail W5426) (if (cons? W5427) (let W5428 (head W5427) (let W5429 (tail W5427) (if (shen.hds=? W5429 where) (let W5430 (tail W5429) (if (cons? W5430) (let W5431 (head W5430) (let W5432 (tail W5430) (shen.comb W5432 (@p W5425 (shen.correct (cons where (cons W5431 (cons W5428 ())))))))) (shen.parse-failure))) (shen.parse-failure)))) (shen.parse-failure))) (shen.parse-failure)))))) (if (shen.parse-failure? W5423) (let W5433 (let W5434 (shen. V5412) (if (shen.parse-failure? W5434) (shen.parse-failure) (let W5435 (shen.<-out W5434) (let W5436 (shen.in-> W5434) (if (shen.hds=? W5436 <-) (let W5437 (tail W5436) (if (cons? W5437) (let W5438 (head W5437) (let W5439 (tail W5437) (shen.comb W5439 (@p W5435 (shen.correct W5438))))) (shen.parse-failure))) (shen.parse-failure)))))) (if (shen.parse-failure? W5433) (let W5440 (let W5441 (shen. V5412) (if (shen.parse-failure? W5441) (shen.parse-failure) (let W5442 (shen.<-out W5441) (let W5443 (shen.in-> W5441) (if (shen.hds=? W5443 ->) (let W5444 (tail W5443) (if (cons? W5444) (let W5445 (head W5444) (let W5446 (tail W5444) (shen.comb W5446 (@p W5442 W5445)))) (shen.parse-failure))) (shen.parse-failure)))))) (if (shen.parse-failure? W5440) (shen.parse-failure) W5440)) W5433)) W5423)) W5413))) + +(defun shen.correct (V5447) (cond ((and (cons? V5447) (and (= where (hd V5447)) (and (cons? (tl V5447)) (and (cons? (tl (tl V5447))) (and (cons? (hd (tl (tl V5447)))) (and (= fail-if (hd (hd (tl (tl V5447))))) (and (cons? (tl (hd (tl (tl V5447))))) (and (cons? (tl (tl (hd (tl (tl V5447)))))) (and (= () (tl (tl (tl (hd (tl (tl V5447))))))) (= () (tl (tl (tl V5447))))))))))))) (cons where (cons (cons and (cons (hd (tl V5447)) (cons (cons not (cons (tl (hd (tl (tl V5447)))) ())) ()))) (tl (tl (hd (tl (tl V5447)))))))) ((and (cons? V5447) (and (= where (hd V5447)) (and (cons? (tl V5447)) (and (cons? (tl (tl V5447))) (= () (tl (tl (tl V5447)))))))) (cons where (cons (cons and (cons (hd (tl V5447)) (cons (cons not (cons (cons = (cons (hd (tl (tl V5447))) (cons (cons fail ()) ()))) ())) ()))) (tl (tl V5447))))) ((and (cons? V5447) (and (= fail-if (hd V5447)) (and (cons? (tl V5447)) (and (cons? (tl (tl V5447))) (= () (tl (tl (tl V5447)))))))) (cons where (cons (cons not (cons (tl V5447) ())) (tl (tl V5447))))) (true (cons where (cons (cons not (cons (cons = (cons V5447 (cons (cons fail ()) ()))) ())) (cons V5447 ())))))) + +(defun shen.t*-rules (V5448 V5449 V5450 V5451 V5452 V5453 V5454 V5455) (let W5456 (+ V5454 1) (let W5457 (if (shen.unlocked? V5453) (let W5458 (shen.lazyderef V5449 V5452) (if (= W5458 ()) (do (shen.incinfs) (thaw V5455)) false)) false) (if (= W5457 false) (let W5459 (if (shen.unlocked? V5453) (let W5460 (shen.lazyderef V5449 V5452) (if (cons? W5460) (let W5461 (hd W5460) (let W5462 (tl W5460) (let W5463 (shen.newpv V5452) (shen.gc V5452 (do (shen.incinfs) (bind W5463 (shen.freshen-rule (shen.deref W5461 V5452)) V5452 V5453 W5456 (freeze (shen.t*-rule V5448 V5451 (fst (shen.lazyderef W5463 V5452)) (snd (shen.lazyderef W5463 V5452)) V5450 V5452 V5453 W5456 (freeze (shen.cut V5452 V5453 W5456 (freeze (shen.t*-rules V5448 W5462 V5450 (+ V5451 1) V5452 V5453 W5456 V5455)))))))))))) false)) false) (if (= W5459 false) (shen.unlock V5453 W5456) W5459)) W5457)))) + +(defun shen.freshen-rule (V5464) (cond ((tuple? V5464) (let W5465 (shen.extract-vars (fst V5464)) (let W5466 (map (lambda Z5467 (cons Z5467 (shen.freshterm Z5467))) W5465) (@p (shen.freshen W5466 (fst V5464)) (shen.freshen W5466 (snd V5464)))))) (true (shen.f-error shen.freshen-rule)))) + +(defun shen.freshen (V5468 V5469) (cond ((= () V5468) V5469) ((and (cons? V5468) (cons? (hd V5468))) (shen.freshen (tl V5468) (shen.beta (hd (hd V5468)) (tl (hd V5468)) V5469))) (true (shen.f-error shen.freshen)))) + +(defun shen.t*-rule (V5470 V5471 V5472 V5473 V5474 V5475 V5476 V5477 V5478) (let W5479 (if (shen.unlocked? V5476) (do (shen.incinfs) (shen.t*-rule-h V5472 V5473 V5474 V5475 V5476 V5477 V5478)) false) (if (= W5479 false) (if (shen.unlocked? V5476) (let W5480 (shen.newpv V5475) (shen.gc V5475 (do (shen.incinfs) (bind W5480 (simple-error (cn "type error in rule " (shen.app V5471 (cn " of " (shen.app V5470 " +" shen.a)) shen.a))) V5475 V5476 V5477 V5478)))) false) W5479))) + +(defun shen.t*-rule-h (V5481 V5482 V5483 V5484 V5485 V5486 V5487) (let W5488 (+ V5486 1) (let W5489 (if (shen.unlocked? V5485) (let W5490 (shen.lazyderef V5481 V5484) (if (= W5490 ()) (let W5491 (shen.lazyderef V5483 V5484) (if (cons? W5491) (let W5492 (shen.lazyderef (hd W5491) V5484) (if (= W5492 -->) (let W5493 (shen.lazyderef (tl W5491) V5484) (if (cons? W5493) (let W5494 (hd W5493) (let W5495 (shen.lazyderef (tl W5493) V5484) (if (= W5495 ()) (do (shen.incinfs) (shen.cut V5484 V5485 W5488 (freeze (shen.t*-correct V5482 W5494 () V5484 V5485 W5488 V5487)))) false))) false)) false)) false)) false)) false) (if (= W5489 false) (let W5496 (if (shen.unlocked? V5485) (let W5497 (shen.newpv V5484) (shen.gc V5484 (let W5498 (shen.newpv V5484) (shen.gc V5484 (let W5499 (shen.newpv V5484) (shen.gc V5484 (do (shen.incinfs) (shen.p-hyps (shen.freshterms V5481) W5497 V5484 V5485 W5488 (freeze (shen.t*-integrity V5481 V5483 W5497 W5498 V5484 V5485 W5488 (freeze (shen.cut V5484 V5485 W5488 (freeze (shen.myassume V5481 V5483 W5499 V5484 V5485 W5488 (freeze (shen.t*-correct V5482 W5498 W5499 V5484 V5485 W5488 V5487)))))))))))))))) false) (if (= W5496 false) (shen.unlock V5485 W5488) W5496)) W5489)))) + +(defun shen.myassume (V5500 V5501 V5502 V5503 V5504 V5505 V5506) (let W5507 (if (shen.unlocked? V5504) (let W5508 (shen.lazyderef V5500 V5503) (if (= W5508 ()) (let W5509 (shen.lazyderef V5502 V5503) (let W5510 (freeze (do (shen.incinfs) (thaw V5506))) (if (= W5509 ()) (thaw W5510) (if (shen.pvar? W5509) (shen.bind! W5509 () V5503 W5510) false)))) false)) false) (if (= W5507 false) (if (shen.unlocked? V5504) (let W5511 (shen.lazyderef V5500 V5503) (if (cons? W5511) (let W5512 (hd W5511) (let W5513 (tl W5511) (let W5514 (shen.lazyderef V5501 V5503) (if (cons? W5514) (let W5515 (hd W5514) (let W5516 (shen.lazyderef (tl W5514) V5503) (if (cons? W5516) (let W5517 (shen.lazyderef (hd W5516) V5503) (if (= W5517 -->) (let W5518 (shen.lazyderef (tl W5516) V5503) (if (cons? W5518) (let W5519 (hd W5518) (let W5520 (shen.lazyderef (tl W5518) V5503) (if (= W5520 ()) (let W5521 (shen.lazyderef V5502 V5503) (let W5522 (lambda Z5523 (lambda Z5524 (lambda Z5525 (lambda Z5526 (do (shen.incinfs) (is! W5515 Z5525 V5503 V5504 V5505 (freeze (is! W5512 Z5523 V5503 V5504 V5505 (freeze (bind Z5524 (intern ":") V5503 V5504 V5505 (freeze (shen.myassume W5513 W5519 Z5526 V5503 V5504 V5505 V5506)))))))))))) (if (cons? W5521) (let W5527 (shen.lazyderef (hd W5521) V5503) (let W5528 (lambda Z5529 (lambda Z5530 (lambda Z5531 (let W5532 (tl W5521) ((((W5522 Z5529) Z5530) Z5531) W5532))))) (if (cons? W5527) (let W5533 (hd W5527) (let W5534 (shen.lazyderef (tl W5527) V5503) (let W5535 (lambda Z5536 (lambda Z5537 (((W5528 W5533) Z5536) Z5537))) (if (cons? W5534) (let W5538 (hd W5534) (let W5539 (shen.lazyderef (tl W5534) V5503) (let W5540 (lambda Z5541 ((W5535 W5538) Z5541)) (if (cons? W5539) (let W5542 (hd W5539) (let W5543 (shen.lazyderef (tl W5539) V5503) (let W5544 (freeze (W5540 W5542)) (if (= W5543 ()) (thaw W5544) (if (shen.pvar? W5543) (shen.bind! W5543 () V5503 W5544) false))))) (if (shen.pvar? W5539) (let W5545 (shen.newpv V5503) (shen.gc V5503 (shen.bind! W5539 (cons W5545 ()) V5503 (freeze (W5540 W5545))))) false))))) (if (shen.pvar? W5534) (let W5546 (shen.newpv V5503) (shen.gc V5503 (let W5547 (shen.newpv V5503) (shen.gc V5503 (shen.bind! W5534 (cons W5546 (cons W5547 ())) V5503 (freeze ((W5535 W5546) W5547))))))) false))))) (if (shen.pvar? W5527) (let W5548 (shen.newpv V5503) (shen.gc V5503 (let W5549 (shen.newpv V5503) (shen.gc V5503 (let W5550 (shen.newpv V5503) (shen.gc V5503 (shen.bind! W5527 (cons W5548 (cons W5549 (cons W5550 ()))) V5503 (freeze (((W5528 W5548) W5549) W5550))))))))) false)))) (if (shen.pvar? W5521) (let W5551 (shen.newpv V5503) (shen.gc V5503 (let W5552 (shen.newpv V5503) (shen.gc V5503 (let W5553 (shen.newpv V5503) (shen.gc V5503 (let W5554 (shen.newpv V5503) (shen.gc V5503 (shen.bind! W5521 (cons (cons W5551 (cons W5552 (cons W5553 ()))) W5554) V5503 (freeze ((((W5522 W5551) W5552) W5553) W5554))))))))))) false)))) false))) false)) false)) false))) false)))) false)) false) W5507))) + +(defun shen.freshterms (V5557) (cond ((= () V5557) ()) ((and (cons? V5557) (cons? (hd V5557))) (shen.freshterms (append (hd V5557) (tl V5557)))) ((and (cons? V5557) (shen.freshterm? (hd V5557))) (adjoin (hd V5557) (shen.freshterms (tl V5557)))) ((cons? V5557) (shen.freshterms (tl V5557))) (true (shen.f-error shen.freshterms)))) + +(defun shen.p-hyps (V5558 V5559 V5560 V5561 V5562 V5563) (let W5564 (if (shen.unlocked? V5561) (let W5565 (shen.lazyderef V5558 V5560) (if (= W5565 ()) (let W5566 (shen.lazyderef V5559 V5560) (let W5567 (freeze (do (shen.incinfs) (thaw V5563))) (if (= W5566 ()) (thaw W5567) (if (shen.pvar? W5566) (shen.bind! W5566 () V5560 W5567) false)))) false)) false) (if (= W5564 false) (if (shen.unlocked? V5561) (let W5568 (shen.lazyderef V5558 V5560) (if (cons? W5568) (let W5569 (hd W5568) (let W5570 (tl W5568) (let W5571 (shen.lazyderef V5559 V5560) (let W5572 (lambda Z5573 (lambda Z5574 (lambda Z5575 (lambda Z5576 (do (shen.incinfs) (bind Z5573 W5569 V5560 V5561 V5562 (freeze (bind Z5574 (intern ":") V5560 V5561 V5562 (freeze (shen.p-hyps W5570 Z5576 V5560 V5561 V5562 V5563)))))))))) (if (cons? W5571) (let W5577 (shen.lazyderef (hd W5571) V5560) (let W5578 (lambda Z5579 (lambda Z5580 (lambda Z5581 (let W5582 (tl W5571) ((((W5572 Z5579) Z5580) Z5581) W5582))))) (if (cons? W5577) (let W5583 (hd W5577) (let W5584 (shen.lazyderef (tl W5577) V5560) (let W5585 (lambda Z5586 (lambda Z5587 (((W5578 W5583) Z5586) Z5587))) (if (cons? W5584) (let W5588 (hd W5584) (let W5589 (shen.lazyderef (tl W5584) V5560) (let W5590 (lambda Z5591 ((W5585 W5588) Z5591)) (if (cons? W5589) (let W5592 (hd W5589) (let W5593 (shen.lazyderef (tl W5589) V5560) (let W5594 (freeze (W5590 W5592)) (if (= W5593 ()) (thaw W5594) (if (shen.pvar? W5593) (shen.bind! W5593 () V5560 W5594) false))))) (if (shen.pvar? W5589) (let W5595 (shen.newpv V5560) (shen.gc V5560 (shen.bind! W5589 (cons W5595 ()) V5560 (freeze (W5590 W5595))))) false))))) (if (shen.pvar? W5584) (let W5596 (shen.newpv V5560) (shen.gc V5560 (let W5597 (shen.newpv V5560) (shen.gc V5560 (shen.bind! W5584 (cons W5596 (cons W5597 ())) V5560 (freeze ((W5585 W5596) W5597))))))) false))))) (if (shen.pvar? W5577) (let W5598 (shen.newpv V5560) (shen.gc V5560 (let W5599 (shen.newpv V5560) (shen.gc V5560 (let W5600 (shen.newpv V5560) (shen.gc V5560 (shen.bind! W5577 (cons W5598 (cons W5599 (cons W5600 ()))) V5560 (freeze (((W5578 W5598) W5599) W5600))))))))) false)))) (if (shen.pvar? W5571) (let W5601 (shen.newpv V5560) (shen.gc V5560 (let W5602 (shen.newpv V5560) (shen.gc V5560 (let W5603 (shen.newpv V5560) (shen.gc V5560 (let W5604 (shen.newpv V5560) (shen.gc V5560 (shen.bind! W5571 (cons (cons W5601 (cons W5602 (cons W5603 ()))) W5604) V5560 (freeze ((((W5572 W5601) W5602) W5603) W5604))))))))))) false)))))) false)) false) W5564))) + +(defun shen.t*-correct (V5605 V5606 V5607 V5608 V5609 V5610 V5611) (let W5612 (+ V5610 1) (let W5613 (if (shen.unlocked? V5609) (let W5614 (shen.lazyderef V5605 V5608) (if (cons? W5614) (let W5615 (shen.lazyderef (hd W5614) V5608) (if (= W5615 where) (let W5616 (shen.lazyderef (tl W5614) V5608) (if (cons? W5616) (let W5617 (hd W5616) (let W5618 (shen.lazyderef (tl W5616) V5608) (if (cons? W5618) (let W5619 (hd W5618) (let W5620 (shen.lazyderef (tl W5618) V5608) (if (= W5620 ()) (let W5621 (shen.newpv V5608) (shen.gc V5608 (do (shen.incinfs) (shen.cut V5608 V5609 W5612 (freeze (bind W5621 (shen.curry W5617) V5608 V5609 W5612 (freeze (shen.system-S-h W5621 boolean V5607 V5608 V5609 W5612 (freeze (shen.cut V5608 V5609 W5612 (freeze (shen.t*-correct W5619 V5606 (cons (cons W5621 (cons (intern ":") (cons verified ()))) V5607) V5608 V5609 W5612 V5611)))))))))))) false))) false))) false)) false)) false)) false) (if (= W5613 false) (let W5622 (if (shen.unlocked? V5609) (do (shen.incinfs) (shen.system-S-h (shen.curry V5605) V5606 V5607 V5608 V5609 W5612 V5611)) false) (if (= W5622 false) (shen.unlock V5609 W5612) W5622)) W5613)))) + +(defun shen.t*-integrity (V5623 V5624 V5625 V5626 V5627 V5628 V5629 V5630) (let W5631 (if (shen.unlocked? V5628) (let W5632 (shen.lazyderef V5623 V5627) (if (= W5632 ()) (do (shen.incinfs) (is! V5624 V5626 V5627 V5628 V5629 V5630)) false)) false) (if (= W5631 false) (if (shen.unlocked? V5628) (let W5633 (shen.lazyderef V5623 V5627) (if (cons? W5633) (let W5634 (hd W5633) (let W5635 (tl W5633) (let W5636 (shen.lazyderef V5624 V5627) (if (cons? W5636) (let W5637 (hd W5636) (let W5638 (shen.lazyderef (tl W5636) V5627) (if (cons? W5638) (let W5639 (shen.lazyderef (hd W5638) V5627) (if (= W5639 -->) (let W5640 (shen.lazyderef (tl W5638) V5627) (if (cons? W5640) (let W5641 (hd W5640) (let W5642 (shen.lazyderef (tl W5640) V5627) (if (= W5642 ()) (do (shen.incinfs) (shen.system-S-h W5634 W5637 V5625 V5627 V5628 V5629 (freeze (shen.t*-integrity W5635 W5641 V5625 V5626 V5627 V5628 V5629 V5630)))) false))) false)) false)) false))) false)))) false)) false) W5631))) + +(defun shen.freshterm? (V5643) (and (absvector? V5643) (and (not (string? V5643)) (= (<-address V5643 0) shen.print-freshterm)))) + +(defun shen.initialise-environment () (do (set shen.*history* ()) (do (set shen.*tc* false) (do (set *property-vector* (shen.dict 20000)) (do (set *macros* (cons (cons shen.macros (lambda X (shen.macros X))) ())) (do (set shen.*gensym* 0) (do (set shen.*tracking* ()) (do (set shen.*profiled* ()) (do (set shen.*special* (cons @p (cons @s (cons @v (cons cons (cons lambda (cons let (cons where (cons set (cons open (cons input+ (cons type ())))))))))))) (do (set shen.*extraspecial* ()) (do (set shen.*spy* false) (do (set shen.*datatypes* ()) (do (set shen.*alldatatypes* ()) (do (set shen.*shen-type-theory-enabled?* true) (do (set shen.*package* null) (do (set shen.*synonyms* ()) (do (set shen.*system* ()) (do (set shen.*occurs* true) (do (set shen.*factorise?* false) (do (set shen.*maxinferences* 1000000) (do (set *maximum-print-sequence-size* 20) (do (set shen.*call* 0) (do (set shen.*infs* 0) (do (set *hush* false) (do (set shen.*optimise* false) (do (set *version* "41.2") (do (set shen.*names* ()) (do (set shen.*step* false) (do (set shen.*it* "") (do (set shen.*residue* ()) (do (set *absolute* ()) (do (set shen.*prolog-memory* 1000) (do (set shen.*loading?* false) (do (set shen.*userdefs* ()) (do (set shen.*demodulation-function* (lambda X X)) (do (set shen.*custom-pattern-compiler* false) (do (set shen.*custom-pattern-reducer* false) (do (if (not (bound? *home-directory*)) (set *home-directory* "") shen.skip) (do (if (not (bound? *sterror*)) (set *sterror* (value *stoutput*)) shen.skip) (do (prolog-memory 10000) (do (set shen.*loading?* false) (do (shen.initialise-arity-table (cons abort (cons 0 (cons absolute (cons 1 (cons absvector? (cons 1 (cons absvector (cons 1 (cons address-> (cons 3 (cons adjoin (cons 2 (cons and (cons 2 (cons append (cons 2 (cons arity (cons 1 (cons assoc (cons 2 (cons atom? (cons 1 (cons boolean? (cons 1 (cons bootstrap (cons 1 (cons bound? (cons 1 (cons bind (cons 6 (cons call (cons 5 (cons cd (cons 1 (cons compile (cons 2 (cons concat (cons 2 (cons cons (cons 2 (cons cons? (cons 1 (cons cn (cons 2 (cons close (cons 1 (cons datatypes (cons 0 (cons declare (cons 2 (cons destroy (cons 1 (cons difference (cons 2 (cons do (cons 2 (cons element? (cons 2 (cons empty? (cons 1 (cons enable-type-theory (cons 1 (cons external (cons 1 (cons error-to-string (cons 1 (cons eval (cons 1 (cons eval-kl (cons 1 (cons explode (cons 1 (cons external (cons 1 (cons factorise (cons 1 (cons factorise? (cons 0 (cons fail-if (cons 2 (cons fail (cons 0 (cons fix (cons 2 (cons findall (cons 7 (cons foreign (cons 1 (cons fork (cons 5 (cons freeze (cons 1 (cons fresh (cons 0 (cons fst (cons 1 (cons fn (cons 1 (cons function (cons 1 (cons gensym (cons 1 (cons get (cons 3 (cons get-time (cons 1 (cons address-> (cons 3 (cons <-address (cons 2 (cons <-vector (cons 2 (cons > (cons 2 (cons >= (cons 2 (cons = (cons 2 (cons hash (cons 2 (cons hd (cons 1 (cons hdv (cons 1 (cons hdstr (cons 1 (cons head (cons 1 (cons hush? (cons 0 (cons hush (cons 1 (cons if (cons 3 (cons include (cons 1 (cons shen.included (cons 0 (cons in-package (cons 1 (cons integer? (cons 1 (cons internal (cons 1 (cons intern (cons 1 (cons inferences (cons 0 (cons input (cons 1 (cons input+ (cons 2 (cons implementation (cons 0 (cons include-all-but (cons 1 (cons intersection (cons 2 (cons internal (cons 1 (cons it (cons 0 (cons is (cons 6 (cons is! (cons 6 (cons language (cons 0 (cons length (cons 1 (cons limit (cons 1 (cons lineread (cons 1 (cons list (cons 1 (cons load (cons 1 (cons < (cons 2 (cons <= (cons 2 (cons vector (cons 1 (cons macroexpand (cons 1 (cons map (cons 2 (cons mapcan (cons 2 (cons maxinferences (cons 1 (cons nl (cons 1 (cons not (cons 1 (cons nth (cons 2 (cons n->string (cons 1 (cons number? (cons 1 (cons occurs-check (cons 1 (cons occurrences (cons 2 (cons occurs? (cons 0 (cons occurs-check (cons 1 (cons open (cons 2 (cons optimise (cons 1 (cons optimise? (cons 0 (cons or (cons 2 (cons os (cons 0 (cons package (cons 3 (cons package? (cons 1 (cons port (cons 0 (cons porters (cons 0 (cons pos (cons 2 (cons preclude-all-but (cons 1 (cons print (cons 1 (cons profile (cons 1 (cons shen.print-prolog-vector (cons 1 (cons shen.print-freshterm (cons 1 (cons shen.printF (cons 1 (cons prolog-memory (cons 1 (cons profile-results (cons 1 (cons pr (cons 2 (cons ps (cons 1 (cons preclude (cons 1 (cons preclude-all-but (cons 1 (cons protect (cons 1 (cons put (cons 4 (cons read-file-as-string (cons 1 (cons read-file-as-bytelist (cons 1 (cons read-file (cons 1 (cons read (cons 1 (cons read-byte (cons 1 (cons read-from-string (cons 1 (cons read-from-string-unprocessed (cons 1 (cons shen.read-unit-string (cons 1 (cons receive (cons 1 (cons release (cons 0 (cons remove (cons 2 (cons reverse (cons 1 (cons set (cons 2 (cons simple-error (cons 1 (cons snd (cons 1 (cons specialise (cons 2 (cons spy (cons 1 (cons shen.spy? (cons 0 (cons step (cons 1 (cons shen.step? (cons 0 (cons stinput (cons 0 (cons stoutput (cons 0 (cons str (cons 1 (cons string->n (cons 1 (cons string->symbol (cons 1 (cons string? (cons 1 (cons subst (cons 3 (cons sum (cons 1 (cons symbol? (cons 1 (cons systemf (cons 1 (cons tail (cons 1 (cons tl (cons 1 (cons tc (cons 1 (cons tc? (cons 0 (cons thaw (cons 1 (cons tlstr (cons 1 (cons track (cons 1 (cons tracked (cons 0 (cons trap-error (cons 2 (cons tuple? (cons 1 (cons type (cons 2 (cons return (cons 5 (cons unabsolute (cons 1 (cons undefmacro (cons 1 (cons unput (cons 3 (cons unprofile (cons 1 (cons union (cons 2 (cons untrack (cons 1 (cons undefmacro (cons 1 (cons update-lambda-table (cons 2 (cons userdefs (cons 0 (cons vector (cons 1 (cons vector? (cons 1 (cons vector-> (cons 3 (cons value (cons 1 (cons variable? (cons 1 (cons var? (cons 5 (cons version (cons 0 (cons when (cons 5 (cons write-byte (cons 2 (cons write-to-file (cons 2 (cons y-or-n? (cons 1 (cons + (cons 2 (cons * (cons 2 (cons / (cons 2 (cons - (cons 2 (cons == (cons 2 (cons (cons 1 (cons (cons 1 (cons (cons 1 (cons @p (cons 2 (cons @v (cons 2 (cons @s (cons 2 ()))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) (do (put shen shen.external-symbols (cons ! (cons } (cons { (cons --> (cons <-- (cons && (cons (intern ":") (cons (intern ";") (cons (intern ":=") (cons (intern ",") (cons _ (cons *language* (cons *implementation* (cons *stinput* (cons *sterror* (cons *stoutput* (cons *home-directory* (cons *version* (cons *maximum-print-sequence-size* (cons *macros* (cons *os* (cons *release* (cons *property-vector* (cons @v (cons @p (cons @s (cons *port* (cons *porters* (cons *hush* (cons <- (cons -> (cons (cons == (cons = (cons >= (cons > (cons ==> (cons /. (cons (cons (cons $ (cons - (cons / (cons * (cons + (cons <= (cons < (cons >> (cons (vector 0) (cons y-or-n? (cons write-to-file (cons write-byte (cons where (cons when (cons warn (cons version (cons verified (cons variable? (cons var? (cons value (cons vector-> (cons <-vector (cons vector (cons vector? (cons u! (cons update-lambda-table (cons unspecialise (cons untrack (cons unit (cons shen.unix (cons union (cons unput (cons unprofile (cons undefmacro (cons unabsolute (cons return (cons type (cons tuple? (cons true (cons trap-error (cons track (cons time (cons thaw (cons tc? (cons tc (cons tl (cons tlstr (cons tlv (cons tail (cons systemf (cons synonyms (cons symbol (cons symbol? (cons string->symbol (cons sum (cons subst (cons string? (cons string->n (cons stream (cons string (cons stinput (cons sterror (cons stoutput (cons step (cons spy (cons specialise (cons snd (cons simple-error (cons set (cons save (cons str (cons run (cons reverse (cons retract (cons remove (cons release (cons read (cons receive (cons read-file (cons read-file-as-bytelist (cons read-file-as-string (cons read-byte (cons read-from-string (cons read-from-string-unprocessed (cons package? (cons put (cons preclude (cons preclude-all-but (cons ps (cons prolog? (cons protect (cons profile-results (cons profile (cons prolog-memory (cons print (cons pr (cons pos (cons porters (cons port (cons package (cons output (cons out (cons os (cons or (cons optimise (cons open (cons occurrences (cons occurs-check (cons n->string (cons number? (cons number (cons null (cons nth (cons not (cons nl (cons mode (cons macroexpand (cons maxinferences (cons mapcan (cons map (cons make-string (cons load (cons loaded (cons list (cons lineread (cons limit (cons length (cons let (cons lazy (cons lambda (cons language (cons is (cons intersection (cons inferences (cons intern (cons integer? (cons input (cons input+ (cons inline (cons include (cons include-all-but (cons it (cons is (cons is! (cons in (cons in-package (cons internal (cons implementation (cons if (cons head (cons hd (cons hdv (cons hdstr (cons hash (cons get (cons get-time (cons gensym (cons fn (cons function (cons fst (cons freeze (cons fresh (cons fork (cons foreign (cons fix (cons file (cons fail (cons fail-if (cons factorise (cons findall (cons false (cons enable-type-theory (cons explode (cons external (cons exception (cons eval-kl (cons eval (cons error-to-string (cons error (cons empty? (cons element? (cons do (cons difference (cons destroy (cons defun (cons define (cons defmacro (cons defcc (cons defprolog (cons declare (cons datatype (cons datatypes (cons shen.ctxt (cons cn (cons cons? (cons cons (cons cond (cons concat (cons compile (cons cd (cons cases (cons call (cons close (cons bind (cons bound? (cons boolean? (cons boolean (cons bootstrap (cons (intern "bar!") (cons atom? (cons asserta (cons assertz (cons assoc (cons arity (cons append (cons and (cons adjoin (cons <-address (cons address-> (cons absvector? (cons absvector (cons absolute (cons abort ()))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) (value *property-vector*)) (set shen.*empty-absvector* (absvector 0))))))))))))))))))))))))))))))))))))))))))))) + +(defun shen.initialise-signedfuncs () (do (set shen.*sigf* ()) (do (set shen.*sigf* (shen.assoc-> abort (lambda V5951 (lambda B5947 (lambda L5948 (lambda Key5949 (lambda C5950 (let A (shen.newpv B5947) (shen.gc B5947 (is! V5951 (cons --> (cons A ())) B5947 L5948 Key5949 C5950)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> absolute (lambda V5956 (lambda B5952 (lambda L5953 (lambda Key5954 (lambda C5955 (is! V5956 (cons string (cons --> (cons (cons list (cons string ())) ()))) B5952 L5953 Key5954 C5955)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> absvector? (lambda V5961 (lambda B5957 (lambda L5958 (lambda Key5959 (lambda C5960 (let A (shen.newpv B5957) (shen.gc B5957 (is! V5961 (cons A (cons --> (cons boolean ()))) B5957 L5958 Key5959 C5960)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> adjoin (lambda V5966 (lambda B5962 (lambda L5963 (lambda Key5964 (lambda C5965 (let A (shen.newpv B5962) (shen.gc B5962 (is! V5966 (cons A (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons (cons list (cons A ())) ()))) ()))) B5962 L5963 Key5964 C5965)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> and (lambda V5971 (lambda B5967 (lambda L5968 (lambda Key5969 (lambda C5970 (is! V5971 (cons boolean (cons --> (cons (cons boolean (cons --> (cons boolean ()))) ()))) B5967 L5968 Key5969 C5970)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> shen.app (lambda V5976 (lambda B5972 (lambda L5973 (lambda Key5974 (lambda C5975 (let A (shen.newpv B5972) (shen.gc B5972 (is! V5976 (cons A (cons --> (cons (cons string (cons --> (cons (cons symbol (cons --> (cons string ()))) ()))) ()))) B5972 L5973 Key5974 C5975)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> append (lambda V5981 (lambda B5977 (lambda L5978 (lambda Key5979 (lambda C5980 (let A (shen.newpv B5977) (shen.gc B5977 (is! V5981 (cons (cons list (cons A ())) (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons (cons list (cons A ())) ()))) ()))) B5977 L5978 Key5979 C5980)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> arity (lambda V5986 (lambda B5982 (lambda L5983 (lambda Key5984 (lambda C5985 (let A (shen.newpv B5982) (shen.gc B5982 (is! V5986 (cons A (cons --> (cons number ()))) B5982 L5983 Key5984 C5985)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> assoc (lambda V5991 (lambda B5987 (lambda L5988 (lambda Key5989 (lambda C5990 (let A (shen.newpv B5987) (shen.gc B5987 (is! V5991 (cons A (cons --> (cons (cons (cons list (cons (cons list (cons A ())) ())) (cons --> (cons (cons list (cons A ())) ()))) ()))) B5987 L5988 Key5989 C5990)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> atom? (lambda V5996 (lambda B5992 (lambda L5993 (lambda Key5994 (lambda C5995 (let A (shen.newpv B5992) (shen.gc B5992 (is! V5996 (cons A (cons --> (cons boolean ()))) B5992 L5993 Key5994 C5995)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> boolean? (lambda V6001 (lambda B5997 (lambda L5998 (lambda Key5999 (lambda C6000 (let A (shen.newpv B5997) (shen.gc B5997 (is! V6001 (cons A (cons --> (cons boolean ()))) B5997 L5998 Key5999 C6000)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> bootstrap (lambda V6006 (lambda B6002 (lambda L6003 (lambda Key6004 (lambda C6005 (is! V6006 (cons string (cons --> (cons string ()))) B6002 L6003 Key6004 C6005)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> bound? (lambda V6011 (lambda B6007 (lambda L6008 (lambda Key6009 (lambda C6010 (is! V6011 (cons symbol (cons --> (cons boolean ()))) B6007 L6008 Key6009 C6010)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> shen.ccons? (lambda V6016 (lambda B6012 (lambda L6013 (lambda Key6014 (lambda C6015 (let A (shen.newpv B6012) (shen.gc B6012 (is! V6016 (cons (cons list (cons A ())) (cons --> (cons boolean ()))) B6012 L6013 Key6014 C6015)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> cd (lambda V6021 (lambda B6017 (lambda L6018 (lambda Key6019 (lambda C6020 (is! V6021 (cons string (cons --> (cons string ()))) B6017 L6018 Key6019 C6020)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> close (lambda V6026 (lambda B6022 (lambda L6023 (lambda Key6024 (lambda C6025 (let A (shen.newpv B6022) (shen.gc B6022 (let B (shen.newpv B6022) (shen.gc B6022 (is! V6026 (cons (cons stream (cons A ())) (cons --> (cons (cons list (cons B ())) ()))) B6022 L6023 Key6024 C6025)))))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> cn (lambda V6031 (lambda B6027 (lambda L6028 (lambda Key6029 (lambda C6030 (is! V6031 (cons string (cons --> (cons (cons string (cons --> (cons string ()))) ()))) B6027 L6028 Key6029 C6030)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> compile (lambda V6036 (lambda B6032 (lambda L6033 (lambda Key6034 (lambda C6035 (let A (shen.newpv B6032) (shen.gc B6032 (let B (shen.newpv B6032) (shen.gc B6032 (is! V6036 (cons (cons (cons list (cons A ())) (cons --> (cons (cons str (cons (cons list (cons A ())) (cons B ()))) ()))) (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons B ()))) ()))) B6032 L6033 Key6034 C6035)))))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> cons? (lambda V6041 (lambda B6037 (lambda L6038 (lambda Key6039 (lambda C6040 (let A (shen.newpv B6037) (shen.gc B6037 (is! V6041 (cons A (cons --> (cons boolean ()))) B6037 L6038 Key6039 C6040)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> datatypes (lambda V6046 (lambda B6042 (lambda L6043 (lambda Key6044 (lambda C6045 (is! V6046 (cons --> (cons (cons list (cons symbol ())) ())) B6042 L6043 Key6044 C6045)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> destroy (lambda V6051 (lambda B6047 (lambda L6048 (lambda Key6049 (lambda C6050 (is! V6051 (cons symbol (cons --> (cons symbol ()))) B6047 L6048 Key6049 C6050)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> difference (lambda V6056 (lambda B6052 (lambda L6053 (lambda Key6054 (lambda C6055 (let A (shen.newpv B6052) (shen.gc B6052 (is! V6056 (cons (cons list (cons A ())) (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons (cons list (cons A ())) ()))) ()))) B6052 L6053 Key6054 C6055)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> do (lambda V6061 (lambda B6057 (lambda L6058 (lambda Key6059 (lambda C6060 (let A (shen.newpv B6057) (shen.gc B6057 (let B (shen.newpv B6057) (shen.gc B6057 (is! V6061 (cons A (cons --> (cons (cons B (cons --> (cons B ()))) ()))) B6057 L6058 Key6059 C6060)))))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> (lambda V6066 (lambda B6062 (lambda L6063 (lambda Key6064 (lambda C6065 (let A (shen.newpv B6062) (shen.gc B6062 (let B (shen.newpv B6062) (shen.gc B6062 (is! V6066 (cons (cons list (cons A ())) (cons --> (cons (cons str (cons (cons list (cons A ())) (cons (cons list (cons B ())) ()))) ()))) B6062 L6063 Key6064 C6065)))))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> (lambda V6071 (lambda B6067 (lambda L6068 (lambda Key6069 (lambda C6070 (let B (shen.newpv B6067) (shen.gc B6067 (let A (shen.newpv B6067) (shen.gc B6067 (is! V6071 (cons (cons list (cons A ())) (cons --> (cons (cons str (cons (cons list (cons B ())) (cons (cons list (cons A ())) ()))) ()))) B6067 L6068 Key6069 C6070)))))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> (lambda V6076 (lambda B6072 (lambda L6073 (lambda Key6074 (lambda C6075 (let A (shen.newpv B6072) (shen.gc B6072 (let B (shen.newpv B6072) (shen.gc B6072 (is! V6076 (cons (cons list (cons A ())) (cons --> (cons (cons str (cons (cons list (cons A ())) (cons (cons list (cons B ())) ()))) ()))) B6072 L6073 Key6074 C6075)))))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> shen.parse-failure? (lambda V6081 (lambda B6077 (lambda L6078 (lambda Key6079 (lambda C6080 (let A (shen.newpv B6077) (shen.gc B6077 (let B (shen.newpv B6077) (shen.gc B6077 (is! V6081 (cons (cons str (cons (cons list (cons A ())) (cons B ()))) (cons --> (cons boolean ()))) B6077 L6078 Key6079 C6080)))))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> shen.parse-failure (lambda V6086 (lambda B6082 (lambda L6083 (lambda Key6084 (lambda C6085 (let A (shen.newpv B6082) (shen.gc B6082 (let B (shen.newpv B6082) (shen.gc B6082 (is! V6086 (cons --> (cons (cons str (cons (cons list (cons A ())) (cons B ()))) ())) B6082 L6083 Key6084 C6085)))))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> shen.<-out (lambda V6091 (lambda B6087 (lambda L6088 (lambda Key6089 (lambda C6090 (let A (shen.newpv B6087) (shen.gc B6087 (let B (shen.newpv B6087) (shen.gc B6087 (is! V6091 (cons (cons str (cons (cons list (cons A ())) (cons B ()))) (cons --> (cons B ()))) B6087 L6088 Key6089 C6090)))))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> shen.in-> (lambda V6096 (lambda B6092 (lambda L6093 (lambda Key6094 (lambda C6095 (let B (shen.newpv B6092) (shen.gc B6092 (let A (shen.newpv B6092) (shen.gc B6092 (is! V6096 (cons (cons str (cons (cons list (cons A ())) (cons B ()))) (cons --> (cons (cons list (cons A ())) ()))) B6092 L6093 Key6094 C6095)))))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> shen.comb (lambda V6101 (lambda B6097 (lambda L6098 (lambda Key6099 (lambda C6100 (let A (shen.newpv B6097) (shen.gc B6097 (let B (shen.newpv B6097) (shen.gc B6097 (is! V6101 (cons (cons list (cons A ())) (cons --> (cons (cons B (cons --> (cons (cons str (cons (cons list (cons A ())) (cons B ()))) ()))) ()))) B6097 L6098 Key6099 C6100)))))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> element? (lambda V6106 (lambda B6102 (lambda L6103 (lambda Key6104 (lambda C6105 (let A (shen.newpv B6102) (shen.gc B6102 (is! V6106 (cons A (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons boolean ()))) ()))) B6102 L6103 Key6104 C6105)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> empty? (lambda V6111 (lambda B6107 (lambda L6108 (lambda Key6109 (lambda C6110 (let A (shen.newpv B6107) (shen.gc B6107 (is! V6111 (cons A (cons --> (cons boolean ()))) B6107 L6108 Key6109 C6110)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> enable-type-theory (lambda V6116 (lambda B6112 (lambda L6113 (lambda Key6114 (lambda C6115 (is! V6116 (cons symbol (cons --> (cons boolean ()))) B6112 L6113 Key6114 C6115)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> external (lambda V6121 (lambda B6117 (lambda L6118 (lambda Key6119 (lambda C6120 (is! V6121 (cons symbol (cons --> (cons (cons list (cons symbol ())) ()))) B6117 L6118 Key6119 C6120)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> error-to-string (lambda V6126 (lambda B6122 (lambda L6123 (lambda Key6124 (lambda C6125 (is! V6126 (cons exception (cons --> (cons string ()))) B6122 L6123 Key6124 C6125)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> explode (lambda V6131 (lambda B6127 (lambda L6128 (lambda Key6129 (lambda C6130 (let A (shen.newpv B6127) (shen.gc B6127 (is! V6131 (cons A (cons --> (cons (cons list (cons string ())) ()))) B6127 L6128 Key6129 C6130)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> factorise (lambda V6136 (lambda B6132 (lambda L6133 (lambda Key6134 (lambda C6135 (is! V6136 (cons symbol (cons --> (cons symbol ()))) B6132 L6133 Key6134 C6135)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> factorise? (lambda V6141 (lambda B6137 (lambda L6138 (lambda Key6139 (lambda C6140 (is! V6141 (cons --> (cons boolean ())) B6137 L6138 Key6139 C6140)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> fail (lambda V6146 (lambda B6142 (lambda L6143 (lambda Key6144 (lambda C6145 (is! V6146 (cons --> (cons symbol ())) B6142 L6143 Key6144 C6145)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> fix (lambda V6151 (lambda B6147 (lambda L6148 (lambda Key6149 (lambda C6150 (let A (shen.newpv B6147) (shen.gc B6147 (is! V6151 (cons (cons A (cons --> (cons A ()))) (cons --> (cons (cons A (cons --> (cons A ()))) ()))) B6147 L6148 Key6149 C6150)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> freeze (lambda V6156 (lambda B6152 (lambda L6153 (lambda Key6154 (lambda C6155 (let A (shen.newpv B6152) (shen.gc B6152 (is! V6156 (cons A (cons --> (cons (cons lazy (cons A ())) ()))) B6152 L6153 Key6154 C6155)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> fst (lambda V6161 (lambda B6157 (lambda L6158 (lambda Key6159 (lambda C6160 (let B (shen.newpv B6157) (shen.gc B6157 (let A (shen.newpv B6157) (shen.gc B6157 (is! V6161 (cons (cons A (cons * (cons B ()))) (cons --> (cons A ()))) B6157 L6158 Key6159 C6160)))))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> gensym (lambda V6166 (lambda B6162 (lambda L6163 (lambda Key6164 (lambda C6165 (is! V6166 (cons symbol (cons --> (cons symbol ()))) B6162 L6163 Key6164 C6165)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> shen.hds=? (lambda V6171 (lambda B6167 (lambda L6168 (lambda Key6169 (lambda C6170 (let A (shen.newpv B6167) (shen.gc B6167 (is! V6171 (cons (cons list (cons A ())) (cons --> (cons (cons A (cons --> (cons boolean ()))) ()))) B6167 L6168 Key6169 C6170)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> hush (lambda V6176 (lambda B6172 (lambda L6173 (lambda Key6174 (lambda C6175 (is! V6176 (cons symbol (cons --> (cons boolean ()))) B6172 L6173 Key6174 C6175)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> hush? (lambda V6181 (lambda B6177 (lambda L6178 (lambda Key6179 (lambda C6180 (is! V6181 (cons --> (cons boolean ())) B6177 L6178 Key6179 C6180)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> <-vector (lambda V6186 (lambda B6182 (lambda L6183 (lambda Key6184 (lambda C6185 (let A (shen.newpv B6182) (shen.gc B6182 (is! V6186 (cons (cons vector (cons A ())) (cons --> (cons (cons number (cons --> (cons A ()))) ()))) B6182 L6183 Key6184 C6185)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> vector-> (lambda V6191 (lambda B6187 (lambda L6188 (lambda Key6189 (lambda C6190 (let A (shen.newpv B6187) (shen.gc B6187 (is! V6191 (cons (cons vector (cons A ())) (cons --> (cons (cons number (cons --> (cons (cons A (cons --> (cons (cons vector (cons A ())) ()))) ()))) ()))) B6187 L6188 Key6189 C6190)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> vector (lambda V6196 (lambda B6192 (lambda L6193 (lambda Key6194 (lambda C6195 (let A (shen.newpv B6192) (shen.gc B6192 (is! V6196 (cons number (cons --> (cons (cons vector (cons A ())) ()))) B6192 L6193 Key6194 C6195)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> get-time (lambda V6201 (lambda B6197 (lambda L6198 (lambda Key6199 (lambda C6200 (is! V6201 (cons symbol (cons --> (cons number ()))) B6197 L6198 Key6199 C6200)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> hash (lambda V6206 (lambda B6202 (lambda L6203 (lambda Key6204 (lambda C6205 (let A (shen.newpv B6202) (shen.gc B6202 (is! V6206 (cons A (cons --> (cons (cons number (cons --> (cons number ()))) ()))) B6202 L6203 Key6204 C6205)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> head (lambda V6211 (lambda B6207 (lambda L6208 (lambda Key6209 (lambda C6210 (let A (shen.newpv B6207) (shen.gc B6207 (is! V6211 (cons (cons list (cons A ())) (cons --> (cons A ()))) B6207 L6208 Key6209 C6210)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> hdv (lambda V6216 (lambda B6212 (lambda L6213 (lambda Key6214 (lambda C6215 (let A (shen.newpv B6212) (shen.gc B6212 (is! V6216 (cons (cons vector (cons A ())) (cons --> (cons A ()))) B6212 L6213 Key6214 C6215)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> hdstr (lambda V6221 (lambda B6217 (lambda L6218 (lambda Key6219 (lambda C6220 (is! V6221 (cons string (cons --> (cons string ()))) B6217 L6218 Key6219 C6220)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> if (lambda V6226 (lambda B6222 (lambda L6223 (lambda Key6224 (lambda C6225 (let A (shen.newpv B6222) (shen.gc B6222 (is! V6226 (cons boolean (cons --> (cons (cons A (cons --> (cons (cons A (cons --> (cons A ()))) ()))) ()))) B6222 L6223 Key6224 C6225)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> in-package (lambda V6231 (lambda B6227 (lambda L6228 (lambda Key6229 (lambda C6230 (is! V6231 (cons symbol (cons --> (cons symbol ()))) B6227 L6228 Key6229 C6230)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> it (lambda V6236 (lambda B6232 (lambda L6233 (lambda Key6234 (lambda C6235 (is! V6236 (cons --> (cons string ())) B6232 L6233 Key6234 C6235)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> implementation (lambda V6241 (lambda B6237 (lambda L6238 (lambda Key6239 (lambda C6240 (is! V6241 (cons --> (cons string ())) B6237 L6238 Key6239 C6240)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> include (lambda V6246 (lambda B6242 (lambda L6243 (lambda Key6244 (lambda C6245 (is! V6246 (cons (cons list (cons symbol ())) (cons --> (cons (cons list (cons symbol ())) ()))) B6242 L6243 Key6244 C6245)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> include-all-but (lambda V6251 (lambda B6247 (lambda L6248 (lambda Key6249 (lambda C6250 (is! V6251 (cons (cons list (cons symbol ())) (cons --> (cons (cons list (cons symbol ())) ()))) B6247 L6248 Key6249 C6250)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> included (lambda V6256 (lambda B6252 (lambda L6253 (lambda Key6254 (lambda C6255 (is! V6256 (cons --> (cons (cons list (cons symbol ())) ())) B6252 L6253 Key6254 C6255)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> inferences (lambda V6261 (lambda B6257 (lambda L6258 (lambda Key6259 (lambda C6260 (is! V6261 (cons --> (cons number ())) B6257 L6258 Key6259 C6260)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> shen.insert (lambda V6266 (lambda B6262 (lambda L6263 (lambda Key6264 (lambda C6265 (let A (shen.newpv B6262) (shen.gc B6262 (is! V6266 (cons A (cons --> (cons (cons string (cons --> (cons string ()))) ()))) B6262 L6263 Key6264 C6265)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> integer? (lambda V6271 (lambda B6267 (lambda L6268 (lambda Key6269 (lambda C6270 (let A (shen.newpv B6267) (shen.gc B6267 (is! V6271 (cons A (cons --> (cons boolean ()))) B6267 L6268 Key6269 C6270)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> internal (lambda V6276 (lambda B6272 (lambda L6273 (lambda Key6274 (lambda C6275 (is! V6276 (cons symbol (cons --> (cons (cons list (cons symbol ())) ()))) B6272 L6273 Key6274 C6275)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> intersection (lambda V6281 (lambda B6277 (lambda L6278 (lambda Key6279 (lambda C6280 (let A (shen.newpv B6277) (shen.gc B6277 (is! V6281 (cons (cons list (cons A ())) (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons (cons list (cons A ())) ()))) ()))) B6277 L6278 Key6279 C6280)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> language (lambda V6286 (lambda B6282 (lambda L6283 (lambda Key6284 (lambda C6285 (is! V6286 (cons --> (cons string ())) B6282 L6283 Key6284 C6285)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> length (lambda V6291 (lambda B6287 (lambda L6288 (lambda Key6289 (lambda C6290 (let A (shen.newpv B6287) (shen.gc B6287 (is! V6291 (cons (cons list (cons A ())) (cons --> (cons number ()))) B6287 L6288 Key6289 C6290)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> limit (lambda V6296 (lambda B6292 (lambda L6293 (lambda Key6294 (lambda C6295 (let A (shen.newpv B6292) (shen.gc B6292 (is! V6296 (cons (cons vector (cons A ())) (cons --> (cons number ()))) B6292 L6293 Key6294 C6295)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> lineread (lambda V6301 (lambda B6297 (lambda L6298 (lambda Key6299 (lambda C6300 (is! V6301 (cons (cons stream (cons in ())) (cons --> (cons (cons list (cons unit ())) ()))) B6297 L6298 Key6299 C6300)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> load (lambda V6306 (lambda B6302 (lambda L6303 (lambda Key6304 (lambda C6305 (is! V6306 (cons string (cons --> (cons symbol ()))) B6302 L6303 Key6304 C6305)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> map (lambda V6311 (lambda B6307 (lambda L6308 (lambda Key6309 (lambda C6310 (let A (shen.newpv B6307) (shen.gc B6307 (let B (shen.newpv B6307) (shen.gc B6307 (is! V6311 (cons (cons A (cons --> (cons B ()))) (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons (cons list (cons B ())) ()))) ()))) B6307 L6308 Key6309 C6310)))))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> mapcan (lambda V6316 (lambda B6312 (lambda L6313 (lambda Key6314 (lambda C6315 (let A (shen.newpv B6312) (shen.gc B6312 (let B (shen.newpv B6312) (shen.gc B6312 (is! V6316 (cons (cons A (cons --> (cons (cons list (cons B ())) ()))) (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons (cons list (cons B ())) ()))) ()))) B6312 L6313 Key6314 C6315)))))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> maxinferences (lambda V6321 (lambda B6317 (lambda L6318 (lambda Key6319 (lambda C6320 (is! V6321 (cons number (cons --> (cons number ()))) B6317 L6318 Key6319 C6320)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> n->string (lambda V6326 (lambda B6322 (lambda L6323 (lambda Key6324 (lambda C6325 (is! V6326 (cons number (cons --> (cons string ()))) B6322 L6323 Key6324 C6325)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> nl (lambda V6331 (lambda B6327 (lambda L6328 (lambda Key6329 (lambda C6330 (is! V6331 (cons number (cons --> (cons number ()))) B6327 L6328 Key6329 C6330)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> not (lambda V6336 (lambda B6332 (lambda L6333 (lambda Key6334 (lambda C6335 (is! V6336 (cons boolean (cons --> (cons boolean ()))) B6332 L6333 Key6334 C6335)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> nth (lambda V6341 (lambda B6337 (lambda L6338 (lambda Key6339 (lambda C6340 (let A (shen.newpv B6337) (shen.gc B6337 (is! V6341 (cons number (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons A ()))) ()))) B6337 L6338 Key6339 C6340)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> number? (lambda V6346 (lambda B6342 (lambda L6343 (lambda Key6344 (lambda C6345 (let A (shen.newpv B6342) (shen.gc B6342 (is! V6346 (cons A (cons --> (cons boolean ()))) B6342 L6343 Key6344 C6345)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> occurrences (lambda V6351 (lambda B6347 (lambda L6348 (lambda Key6349 (lambda C6350 (let A (shen.newpv B6347) (shen.gc B6347 (let B (shen.newpv B6347) (shen.gc B6347 (is! V6351 (cons A (cons --> (cons (cons B (cons --> (cons number ()))) ()))) B6347 L6348 Key6349 C6350)))))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> occurs-check (lambda V6356 (lambda B6352 (lambda L6353 (lambda Key6354 (lambda C6355 (is! V6356 (cons symbol (cons --> (cons boolean ()))) B6352 L6353 Key6354 C6355)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> occurs? (lambda V6361 (lambda B6357 (lambda L6358 (lambda Key6359 (lambda C6360 (is! V6361 (cons --> (cons boolean ())) B6357 L6358 Key6359 C6360)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> optimise (lambda V6366 (lambda B6362 (lambda L6363 (lambda Key6364 (lambda C6365 (is! V6366 (cons symbol (cons --> (cons boolean ()))) B6362 L6363 Key6364 C6365)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> optimise? (lambda V6371 (lambda B6367 (lambda L6368 (lambda Key6369 (lambda C6370 (is! V6371 (cons --> (cons boolean ())) B6367 L6368 Key6369 C6370)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> or (lambda V6376 (lambda B6372 (lambda L6373 (lambda Key6374 (lambda C6375 (is! V6376 (cons boolean (cons --> (cons (cons boolean (cons --> (cons boolean ()))) ()))) B6372 L6373 Key6374 C6375)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> os (lambda V6381 (lambda B6377 (lambda L6378 (lambda Key6379 (lambda C6380 (is! V6381 (cons --> (cons string ())) B6377 L6378 Key6379 C6380)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> package? (lambda V6386 (lambda B6382 (lambda L6383 (lambda Key6384 (lambda C6385 (is! V6386 (cons symbol (cons --> (cons boolean ()))) B6382 L6383 Key6384 C6385)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> port (lambda V6391 (lambda B6387 (lambda L6388 (lambda Key6389 (lambda C6390 (is! V6391 (cons --> (cons string ())) B6387 L6388 Key6389 C6390)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> porters (lambda V6396 (lambda B6392 (lambda L6393 (lambda Key6394 (lambda C6395 (is! V6396 (cons --> (cons string ())) B6392 L6393 Key6394 C6395)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> pos (lambda V6401 (lambda B6397 (lambda L6398 (lambda Key6399 (lambda C6400 (is! V6401 (cons string (cons --> (cons (cons number (cons --> (cons string ()))) ()))) B6397 L6398 Key6399 C6400)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> pr (lambda V6406 (lambda B6402 (lambda L6403 (lambda Key6404 (lambda C6405 (is! V6406 (cons string (cons --> (cons (cons (cons stream (cons out ())) (cons --> (cons string ()))) ()))) B6402 L6403 Key6404 C6405)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> print (lambda V6411 (lambda B6407 (lambda L6408 (lambda Key6409 (lambda C6410 (let A (shen.newpv B6407) (shen.gc B6407 (is! V6411 (cons A (cons --> (cons A ()))) B6407 L6408 Key6409 C6410)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> profile (lambda V6416 (lambda B6412 (lambda L6413 (lambda Key6414 (lambda C6415 (is! V6416 (cons symbol (cons --> (cons symbol ()))) B6412 L6413 Key6414 C6415)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> preclude (lambda V6421 (lambda B6417 (lambda L6418 (lambda Key6419 (lambda C6420 (is! V6421 (cons (cons list (cons symbol ())) (cons --> (cons (cons list (cons symbol ())) ()))) B6417 L6418 Key6419 C6420)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> shen.proc-nl (lambda V6426 (lambda B6422 (lambda L6423 (lambda Key6424 (lambda C6425 (is! V6426 (cons string (cons --> (cons string ()))) B6422 L6423 Key6424 C6425)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> profile-results (lambda V6431 (lambda B6427 (lambda L6428 (lambda Key6429 (lambda C6430 (is! V6431 (cons symbol (cons --> (cons (cons symbol (cons * (cons number ()))) ()))) B6427 L6428 Key6429 C6430)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> protect (lambda V6436 (lambda B6432 (lambda L6433 (lambda Key6434 (lambda C6435 (let A (shen.newpv B6432) (shen.gc B6432 (is! V6436 (cons A (cons --> (cons A ()))) B6432 L6433 Key6434 C6435)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> preclude-all-but (lambda V6441 (lambda B6437 (lambda L6438 (lambda Key6439 (lambda C6440 (is! V6441 (cons (cons list (cons symbol ())) (cons --> (cons (cons list (cons symbol ())) ()))) B6437 L6438 Key6439 C6440)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> shen.prhush (lambda V6446 (lambda B6442 (lambda L6443 (lambda Key6444 (lambda C6445 (is! V6446 (cons string (cons --> (cons (cons (cons stream (cons out ())) (cons --> (cons string ()))) ()))) B6442 L6443 Key6444 C6445)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> prolog-memory (lambda V6451 (lambda B6447 (lambda L6448 (lambda Key6449 (lambda C6450 (is! V6451 (cons number (cons --> (cons number ()))) B6447 L6448 Key6449 C6450)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> ps (lambda V6456 (lambda B6452 (lambda L6453 (lambda Key6454 (lambda C6455 (is! V6456 (cons symbol (cons --> (cons (cons list (cons unit ())) ()))) B6452 L6453 Key6454 C6455)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> read (lambda V6461 (lambda B6457 (lambda L6458 (lambda Key6459 (lambda C6460 (is! V6461 (cons (cons stream (cons in ())) (cons --> (cons unit ()))) B6457 L6458 Key6459 C6460)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> read-byte (lambda V6466 (lambda B6462 (lambda L6463 (lambda Key6464 (lambda C6465 (is! V6466 (cons (cons stream (cons in ())) (cons --> (cons number ()))) B6462 L6463 Key6464 C6465)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> read-file-as-bytelist (lambda V6471 (lambda B6467 (lambda L6468 (lambda Key6469 (lambda C6470 (is! V6471 (cons string (cons --> (cons (cons list (cons number ())) ()))) B6467 L6468 Key6469 C6470)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> read-file-as-string (lambda V6476 (lambda B6472 (lambda L6473 (lambda Key6474 (lambda C6475 (is! V6476 (cons string (cons --> (cons string ()))) B6472 L6473 Key6474 C6475)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> read-file (lambda V6481 (lambda B6477 (lambda L6478 (lambda Key6479 (lambda C6480 (is! V6481 (cons string (cons --> (cons (cons list (cons unit ())) ()))) B6477 L6478 Key6479 C6480)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> read-from-string (lambda V6486 (lambda B6482 (lambda L6483 (lambda Key6484 (lambda C6485 (is! V6486 (cons string (cons --> (cons (cons list (cons unit ())) ()))) B6482 L6483 Key6484 C6485)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> read-from-string-unprocessed (lambda V6491 (lambda B6487 (lambda L6488 (lambda Key6489 (lambda C6490 (is! V6491 (cons string (cons --> (cons (cons list (cons unit ())) ()))) B6487 L6488 Key6489 C6490)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> release (lambda V6496 (lambda B6492 (lambda L6493 (lambda Key6494 (lambda C6495 (is! V6496 (cons --> (cons string ())) B6492 L6493 Key6494 C6495)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> remove (lambda V6501 (lambda B6497 (lambda L6498 (lambda Key6499 (lambda C6500 (let A (shen.newpv B6497) (shen.gc B6497 (is! V6501 (cons A (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons (cons list (cons A ())) ()))) ()))) B6497 L6498 Key6499 C6500)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> reverse (lambda V6506 (lambda B6502 (lambda L6503 (lambda Key6504 (lambda C6505 (let A (shen.newpv B6502) (shen.gc B6502 (is! V6506 (cons (cons list (cons A ())) (cons --> (cons (cons list (cons A ())) ()))) B6502 L6503 Key6504 C6505)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> simple-error (lambda V6511 (lambda B6507 (lambda L6508 (lambda Key6509 (lambda C6510 (let A (shen.newpv B6507) (shen.gc B6507 (is! V6511 (cons string (cons --> (cons A ()))) B6507 L6508 Key6509 C6510)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> snd (lambda V6516 (lambda B6512 (lambda L6513 (lambda Key6514 (lambda C6515 (let A (shen.newpv B6512) (shen.gc B6512 (let B (shen.newpv B6512) (shen.gc B6512 (is! V6516 (cons (cons A (cons * (cons B ()))) (cons --> (cons B ()))) B6512 L6513 Key6514 C6515)))))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> specialise (lambda V6521 (lambda B6517 (lambda L6518 (lambda Key6519 (lambda C6520 (is! V6521 (cons symbol (cons --> (cons (cons number (cons --> (cons symbol ()))) ()))) B6517 L6518 Key6519 C6520)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> spy (lambda V6526 (lambda B6522 (lambda L6523 (lambda Key6524 (lambda C6525 (is! V6526 (cons symbol (cons --> (cons boolean ()))) B6522 L6523 Key6524 C6525)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> shen.spy? (lambda V6531 (lambda B6527 (lambda L6528 (lambda Key6529 (lambda C6530 (is! V6531 (cons --> (cons boolean ())) B6527 L6528 Key6529 C6530)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> step (lambda V6536 (lambda B6532 (lambda L6533 (lambda Key6534 (lambda C6535 (is! V6536 (cons symbol (cons --> (cons boolean ()))) B6532 L6533 Key6534 C6535)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> shen.step? (lambda V6541 (lambda B6537 (lambda L6538 (lambda Key6539 (lambda C6540 (is! V6541 (cons --> (cons boolean ())) B6537 L6538 Key6539 C6540)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> stinput (lambda V6546 (lambda B6542 (lambda L6543 (lambda Key6544 (lambda C6545 (is! V6546 (cons --> (cons (cons stream (cons in ())) ())) B6542 L6543 Key6544 C6545)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> sterror (lambda V6551 (lambda B6547 (lambda L6548 (lambda Key6549 (lambda C6550 (is! V6551 (cons --> (cons (cons stream (cons out ())) ())) B6547 L6548 Key6549 C6550)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> stoutput (lambda V6556 (lambda B6552 (lambda L6553 (lambda Key6554 (lambda C6555 (is! V6556 (cons --> (cons (cons stream (cons out ())) ())) B6552 L6553 Key6554 C6555)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> string? (lambda V6561 (lambda B6557 (lambda L6558 (lambda Key6559 (lambda C6560 (let A (shen.newpv B6557) (shen.gc B6557 (is! V6561 (cons A (cons --> (cons boolean ()))) B6557 L6558 Key6559 C6560)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> str (lambda V6566 (lambda B6562 (lambda L6563 (lambda Key6564 (lambda C6565 (let A (shen.newpv B6562) (shen.gc B6562 (is! V6566 (cons A (cons --> (cons string ()))) B6562 L6563 Key6564 C6565)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> string->n (lambda V6571 (lambda B6567 (lambda L6568 (lambda Key6569 (lambda C6570 (is! V6571 (cons string (cons --> (cons number ()))) B6567 L6568 Key6569 C6570)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> string->symbol (lambda V6576 (lambda B6572 (lambda L6573 (lambda Key6574 (lambda C6575 (is! V6576 (cons string (cons --> (cons symbol ()))) B6572 L6573 Key6574 C6575)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> sum (lambda V6581 (lambda B6577 (lambda L6578 (lambda Key6579 (lambda C6580 (is! V6581 (cons (cons list (cons number ())) (cons --> (cons number ()))) B6577 L6578 Key6579 C6580)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> symbol? (lambda V6586 (lambda B6582 (lambda L6583 (lambda Key6584 (lambda C6585 (let A (shen.newpv B6582) (shen.gc B6582 (is! V6586 (cons A (cons --> (cons boolean ()))) B6582 L6583 Key6584 C6585)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> systemf (lambda V6591 (lambda B6587 (lambda L6588 (lambda Key6589 (lambda C6590 (is! V6591 (cons symbol (cons --> (cons symbol ()))) B6587 L6588 Key6589 C6590)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> system-S? (lambda V6596 (lambda B6592 (lambda L6593 (lambda Key6594 (lambda C6595 (is! V6596 (cons --> (cons boolean ())) B6592 L6593 Key6594 C6595)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> tail (lambda V6601 (lambda B6597 (lambda L6598 (lambda Key6599 (lambda C6600 (let A (shen.newpv B6597) (shen.gc B6597 (is! V6601 (cons (cons list (cons A ())) (cons --> (cons (cons list (cons A ())) ()))) B6597 L6598 Key6599 C6600)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> tlstr (lambda V6606 (lambda B6602 (lambda L6603 (lambda Key6604 (lambda C6605 (is! V6606 (cons string (cons --> (cons string ()))) B6602 L6603 Key6604 C6605)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> tlv (lambda V6611 (lambda B6607 (lambda L6608 (lambda Key6609 (lambda C6610 (let A (shen.newpv B6607) (shen.gc B6607 (is! V6611 (cons (cons vector (cons A ())) (cons --> (cons (cons vector (cons A ())) ()))) B6607 L6608 Key6609 C6610)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> tc (lambda V6616 (lambda B6612 (lambda L6613 (lambda Key6614 (lambda C6615 (is! V6616 (cons symbol (cons --> (cons boolean ()))) B6612 L6613 Key6614 C6615)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> tc? (lambda V6621 (lambda B6617 (lambda L6618 (lambda Key6619 (lambda C6620 (is! V6621 (cons --> (cons boolean ())) B6617 L6618 Key6619 C6620)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> thaw (lambda V6626 (lambda B6622 (lambda L6623 (lambda Key6624 (lambda C6625 (let A (shen.newpv B6622) (shen.gc B6622 (is! V6626 (cons (cons lazy (cons A ())) (cons --> (cons A ()))) B6622 L6623 Key6624 C6625)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> track (lambda V6631 (lambda B6627 (lambda L6628 (lambda Key6629 (lambda C6630 (is! V6631 (cons symbol (cons --> (cons symbol ()))) B6627 L6628 Key6629 C6630)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> tracked (lambda V6636 (lambda B6632 (lambda L6633 (lambda Key6634 (lambda C6635 (is! V6636 (cons --> (cons (cons list (cons symbol ())) ())) B6632 L6633 Key6634 C6635)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> trap-error (lambda V6641 (lambda B6637 (lambda L6638 (lambda Key6639 (lambda C6640 (let A (shen.newpv B6637) (shen.gc B6637 (is! V6641 (cons A (cons --> (cons (cons (cons exception (cons --> (cons A ()))) (cons --> (cons A ()))) ()))) B6637 L6638 Key6639 C6640)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> tuple? (lambda V6646 (lambda B6642 (lambda L6643 (lambda Key6644 (lambda C6645 (let A (shen.newpv B6642) (shen.gc B6642 (is! V6646 (cons A (cons --> (cons boolean ()))) B6642 L6643 Key6644 C6645)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> unabsolute (lambda V6651 (lambda B6647 (lambda L6648 (lambda Key6649 (lambda C6650 (is! V6651 (cons string (cons --> (cons (cons list (cons string ())) ()))) B6647 L6648 Key6649 C6650)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> undefmacro (lambda V6656 (lambda B6652 (lambda L6653 (lambda Key6654 (lambda C6655 (is! V6656 (cons symbol (cons --> (cons symbol ()))) B6652 L6653 Key6654 C6655)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> union (lambda V6661 (lambda B6657 (lambda L6658 (lambda Key6659 (lambda C6660 (let A (shen.newpv B6657) (shen.gc B6657 (is! V6661 (cons (cons list (cons A ())) (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons (cons list (cons A ())) ()))) ()))) B6657 L6658 Key6659 C6660)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> unprofile (lambda V6666 (lambda B6662 (lambda L6663 (lambda Key6664 (lambda C6665 (is! V6666 (cons symbol (cons --> (cons symbol ()))) B6662 L6663 Key6664 C6665)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> untrack (lambda V6671 (lambda B6667 (lambda L6668 (lambda Key6669 (lambda C6670 (is! V6671 (cons symbol (cons --> (cons symbol ()))) B6667 L6668 Key6669 C6670)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> userdefs (lambda V6676 (lambda B6672 (lambda L6673 (lambda Key6674 (lambda C6675 (is! V6676 (cons --> (cons (cons list (cons symbol ())) ())) B6672 L6673 Key6674 C6675)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> variable? (lambda V6681 (lambda B6677 (lambda L6678 (lambda Key6679 (lambda C6680 (let A (shen.newpv B6677) (shen.gc B6677 (is! V6681 (cons A (cons --> (cons boolean ()))) B6677 L6678 Key6679 C6680)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> vector? (lambda V6686 (lambda B6682 (lambda L6683 (lambda Key6684 (lambda C6685 (let A (shen.newpv B6682) (shen.gc B6682 (is! V6686 (cons A (cons --> (cons boolean ()))) B6682 L6683 Key6684 C6685)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> version (lambda V6691 (lambda B6687 (lambda L6688 (lambda Key6689 (lambda C6690 (is! V6691 (cons --> (cons string ())) B6687 L6688 Key6689 C6690)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> write-to-file (lambda V6696 (lambda B6692 (lambda L6693 (lambda Key6694 (lambda C6695 (let A (shen.newpv B6692) (shen.gc B6692 (is! V6696 (cons string (cons --> (cons (cons A (cons --> (cons A ()))) ()))) B6692 L6693 Key6694 C6695)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> write-byte (lambda V6701 (lambda B6697 (lambda L6698 (lambda Key6699 (lambda C6700 (is! V6701 (cons number (cons --> (cons (cons (cons stream (cons out ())) (cons --> (cons number ()))) ()))) B6697 L6698 Key6699 C6700)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> y-or-n? (lambda V6706 (lambda B6702 (lambda L6703 (lambda Key6704 (lambda C6705 (is! V6706 (cons string (cons --> (cons boolean ()))) B6702 L6703 Key6704 C6705)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> > (lambda V6711 (lambda B6707 (lambda L6708 (lambda Key6709 (lambda C6710 (is! V6711 (cons number (cons --> (cons (cons number (cons --> (cons boolean ()))) ()))) B6707 L6708 Key6709 C6710)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> < (lambda V6716 (lambda B6712 (lambda L6713 (lambda Key6714 (lambda C6715 (is! V6716 (cons number (cons --> (cons (cons number (cons --> (cons boolean ()))) ()))) B6712 L6713 Key6714 C6715)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> >= (lambda V6721 (lambda B6717 (lambda L6718 (lambda Key6719 (lambda C6720 (is! V6721 (cons number (cons --> (cons (cons number (cons --> (cons boolean ()))) ()))) B6717 L6718 Key6719 C6720)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> <= (lambda V6726 (lambda B6722 (lambda L6723 (lambda Key6724 (lambda C6725 (is! V6726 (cons number (cons --> (cons (cons number (cons --> (cons boolean ()))) ()))) B6722 L6723 Key6724 C6725)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> = (lambda V6731 (lambda B6727 (lambda L6728 (lambda Key6729 (lambda C6730 (let A (shen.newpv B6727) (shen.gc B6727 (is! V6731 (cons A (cons --> (cons (cons A (cons --> (cons boolean ()))) ()))) B6727 L6728 Key6729 C6730)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> + (lambda V6736 (lambda B6732 (lambda L6733 (lambda Key6734 (lambda C6735 (is! V6736 (cons number (cons --> (cons (cons number (cons --> (cons number ()))) ()))) B6732 L6733 Key6734 C6735)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> / (lambda V6741 (lambda B6737 (lambda L6738 (lambda Key6739 (lambda C6740 (is! V6741 (cons number (cons --> (cons (cons number (cons --> (cons number ()))) ()))) B6737 L6738 Key6739 C6740)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> - (lambda V6746 (lambda B6742 (lambda L6743 (lambda Key6744 (lambda C6745 (is! V6746 (cons number (cons --> (cons (cons number (cons --> (cons number ()))) ()))) B6742 L6743 Key6744 C6745)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> * (lambda V6751 (lambda B6747 (lambda L6748 (lambda Key6749 (lambda C6750 (is! V6751 (cons number (cons --> (cons (cons number (cons --> (cons number ()))) ()))) B6747 L6748 Key6749 C6750)))))) (value shen.*sigf*))) (set shen.*sigf* (shen.assoc-> == (lambda V6756 (lambda B6752 (lambda L6753 (lambda Key6754 (lambda C6755 (let A (shen.newpv B6752) (shen.gc B6752 (let B (shen.newpv B6752) (shen.gc B6752 (is! V6756 (cons A (cons --> (cons (cons B (cons --> (cons boolean ()))) ()))) B6752 L6753 Key6754 C6755)))))))))) (value shen.*sigf*)))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) + +(defun shen.initialise-lambda-forms () (do (shen.set-lambda-form-entry (cons shen.tuple (lambda Y1220 (shen.tuple Y1220)))) (do (shen.set-lambda-form-entry (cons shen.pvar (lambda Y1219 (shen.pvar Y1219)))) (do (shen.set-lambda-form-entry (cons shen.dictionary (lambda Y1218 (shen.dictionary Y1218)))) (do (shen.set-lambda-form-entry (cons shen.print-prolog-vector (lambda Y1217 (shen.print-prolog-vector Y1217)))) (do (shen.set-lambda-form-entry (cons shen.print-freshterm (lambda Y1216 (shen.print-freshterm Y1216)))) (do (shen.set-lambda-form-entry (cons shen.printF (lambda Y1215 (shen.printF Y1215)))) (do (shen.set-lambda-form-entry (cons adjoin (lambda Y1207 (lambda Y1208 (adjoin Y1207 Y1208))))) (do (shen.set-lambda-form-entry (cons and (lambda Y1205 (lambda Y1206 (and Y1205 Y1206))))) (do (shen.set-lambda-form-entry (cons append (lambda Y1203 (lambda Y1204 (append Y1203 Y1204))))) (do (shen.set-lambda-form-entry (cons arity (lambda Y1202 (arity Y1202)))) (do (shen.set-lambda-form-entry (cons assoc (lambda Y1200 (lambda Y1201 (assoc Y1200 Y1201))))) (do (shen.set-lambda-form-entry (cons atom? (lambda Y1199 (atom? Y1199)))) (do (shen.set-lambda-form-entry (cons boolean? (lambda Y1198 (boolean? Y1198)))) (do (shen.set-lambda-form-entry (cons bound? (lambda Y1196 (bound? Y1196)))) (do (shen.set-lambda-form-entry (cons bind (lambda Y1190 (lambda Y1191 (lambda Y1192 (lambda Y1193 (lambda Y1194 (lambda Y1195 (bind Y1190 Y1191 Y1192 Y1193 Y1194 Y1195))))))))) (do (shen.set-lambda-form-entry (cons call (lambda Y1185 (lambda Y1186 (lambda Y1187 (lambda Y1188 (lambda Y1189 (call Y1185 Y1186 Y1187 Y1188 Y1189)))))))) (do (shen.set-lambda-form-entry (cons compile (lambda Y1182 (lambda Y1183 (compile Y1182 Y1183))))) (do (shen.set-lambda-form-entry (cons concat (lambda Y1180 (lambda Y1181 (concat Y1180 Y1181))))) (do (shen.set-lambda-form-entry (cons cons (lambda Y1178 (lambda Y1179 (cons Y1178 Y1179))))) (do (shen.set-lambda-form-entry (cons cons? (lambda Y1177 (cons? Y1177)))) (do (shen.set-lambda-form-entry (cons cn (lambda Y1175 (lambda Y1176 (cn Y1175 Y1176))))) (do (shen.set-lambda-form-entry (cons declare (lambda Y1172 (lambda Y1173 (declare Y1172 Y1173))))) (do (shen.set-lambda-form-entry (cons destroy (lambda Y1171 (destroy Y1171)))) (do (shen.set-lambda-form-entry (cons difference (lambda Y1169 (lambda Y1170 (difference Y1169 Y1170))))) (do (shen.set-lambda-form-entry (cons do (lambda Y1167 (lambda Y1168 (do Y1167 Y1168))))) (do (shen.set-lambda-form-entry (cons element? (lambda Y1165 (lambda Y1166 (element? Y1165 Y1166))))) (do (shen.set-lambda-form-entry (cons empty? (lambda Y1164 (empty? Y1164)))) (do (shen.set-lambda-form-entry (cons external (lambda Y1162 (external Y1162)))) (do (shen.set-lambda-form-entry (cons eval (lambda Y1160 (eval Y1160)))) (do (shen.set-lambda-form-entry (cons explode (lambda Y1158 (explode Y1158)))) (do (shen.set-lambda-form-entry (cons external (lambda Y1157 (external Y1157)))) (do (shen.set-lambda-form-entry (cons fail-if (lambda Y1154 (lambda Y1155 (fail-if Y1154 Y1155))))) (do (shen.set-lambda-form-entry (cons fork (lambda Y1140 (lambda Y1141 (lambda Y1142 (lambda Y1143 (lambda Y1144 (fork Y1140 Y1141 Y1142 Y1143 Y1144)))))))) (do (shen.set-lambda-form-entry (cons freeze (lambda Y1139 (freeze Y1139)))) (do (shen.set-lambda-form-entry (cons fst (lambda Y1138 (fst Y1138)))) (do (shen.set-lambda-form-entry (cons fn (lambda Y1137 (fn Y1137)))) (do (shen.set-lambda-form-entry (cons function (lambda Y1136 (function Y1136)))) (do (shen.set-lambda-form-entry (cons gensym (lambda Y1135 (gensym Y1135)))) (do (shen.set-lambda-form-entry (cons get (lambda Y1132 (lambda Y1133 (lambda Y1134 (get Y1132 Y1133 Y1134)))))) (do (shen.set-lambda-form-entry (cons <-vector (lambda Y1124 (lambda Y1125 (<-vector Y1124 Y1125))))) (do (shen.set-lambda-form-entry (cons > (lambda Y1122 (lambda Y1123 (> Y1122 Y1123))))) (do (shen.set-lambda-form-entry (cons >= (lambda Y1120 (lambda Y1121 (>= Y1120 Y1121))))) (do (shen.set-lambda-form-entry (cons = (lambda Y1118 (lambda Y1119 (= Y1118 Y1119))))) (do (shen.set-lambda-form-entry (cons hash (lambda Y1116 (lambda Y1117 (hash Y1116 Y1117))))) (do (shen.set-lambda-form-entry (cons hd (lambda Y1115 (hd Y1115)))) (do (shen.set-lambda-form-entry (cons hdv (lambda Y1114 (hdv Y1114)))) (do (shen.set-lambda-form-entry (cons hdstr (lambda Y1113 (hdstr Y1113)))) (do (shen.set-lambda-form-entry (cons head (lambda Y1112 (head Y1112)))) (do (shen.set-lambda-form-entry (cons if (lambda Y1108 (lambda Y1109 (lambda Y1110 (if Y1108 Y1109 Y1110)))))) (do (shen.set-lambda-form-entry (cons integer? (lambda Y1105 (integer? Y1105)))) (do (shen.set-lambda-form-entry (cons intern (lambda Y1103 (intern Y1103)))) (do (shen.set-lambda-form-entry (cons input (lambda Y1102 (input Y1102)))) (do (shen.set-lambda-form-entry (cons input+ (lambda Y1100 (lambda Y1101 (input+ Y1100 Y1101))))) (do (shen.set-lambda-form-entry (cons is (lambda Y1090 (lambda Y1091 (lambda Y1092 (lambda Y1093 (lambda Y1094 (lambda Y1095 (is Y1090 Y1091 Y1092 Y1093 Y1094 Y1095))))))))) (do (shen.set-lambda-form-entry (cons is! (lambda Y1084 (lambda Y1085 (lambda Y1086 (lambda Y1087 (lambda Y1088 (lambda Y1089 (is! Y1084 Y1085 Y1086 Y1087 Y1088 Y1089))))))))) (do (shen.set-lambda-form-entry (cons length (lambda Y1083 (length Y1083)))) (do (shen.set-lambda-form-entry (cons limit (lambda Y1082 (limit Y1082)))) (do (shen.set-lambda-form-entry (cons lineread (lambda Y1081 (lineread Y1081)))) (do (shen.set-lambda-form-entry (cons load (lambda Y1080 (load Y1080)))) (do (shen.set-lambda-form-entry (cons < (lambda Y1078 (lambda Y1079 (< Y1078 Y1079))))) (do (shen.set-lambda-form-entry (cons <= (lambda Y1076 (lambda Y1077 (<= Y1076 Y1077))))) (do (shen.set-lambda-form-entry (cons vector (lambda Y1075 (vector Y1075)))) (do (shen.set-lambda-form-entry (cons macroexpand (lambda Y1074 (macroexpand Y1074)))) (do (shen.set-lambda-form-entry (cons map (lambda Y1072 (lambda Y1073 (map Y1072 Y1073))))) (do (shen.set-lambda-form-entry (cons mapcan (lambda Y1070 (lambda Y1071 (mapcan Y1070 Y1071))))) (do (shen.set-lambda-form-entry (cons nl (lambda Y1068 (nl Y1068)))) (do (shen.set-lambda-form-entry (cons not (lambda Y1067 (not Y1067)))) (do (shen.set-lambda-form-entry (cons number? (lambda Y1063 (number? Y1063)))) (do (shen.set-lambda-form-entry (cons occurrences (lambda Y1060 (lambda Y1061 (occurrences Y1060 Y1061))))) (do (shen.set-lambda-form-entry (cons or (lambda Y1054 (lambda Y1055 (or Y1054 Y1055))))) (do (shen.set-lambda-form-entry (cons pos (lambda Y1051 (lambda Y1052 (pos Y1051 Y1052))))) (do (shen.set-lambda-form-entry (cons print (lambda Y1049 (print Y1049)))) (do (shen.set-lambda-form-entry (cons shen.print-prolog-vector (lambda Y1047 (shen.print-prolog-vector Y1047)))) (do (shen.set-lambda-form-entry (cons shen.print-freshterm (lambda Y1046 (shen.print-freshterm Y1046)))) (do (shen.set-lambda-form-entry (cons shen.printF (lambda Y1045 (shen.printF Y1045)))) (do (shen.set-lambda-form-entry (cons prolog-memory (lambda Y1044 (prolog-memory Y1044)))) (do (shen.set-lambda-form-entry (cons pr (lambda Y1041 (lambda Y1042 (pr Y1041 Y1042))))) (do (shen.set-lambda-form-entry (cons ps (lambda Y1040 (ps Y1040)))) (do (shen.set-lambda-form-entry (cons protect (lambda Y1037 (protect Y1037)))) (do (shen.set-lambda-form-entry (cons put (lambda Y1033 (lambda Y1034 (lambda Y1035 (lambda Y1036 (put Y1033 Y1034 Y1035 Y1036))))))) (do (shen.set-lambda-form-entry (cons read-file-as-bytelist (lambda Y1031 (read-file-as-bytelist Y1031)))) (do (shen.set-lambda-form-entry (cons read-file (lambda Y1030 (read-file Y1030)))) (do (shen.set-lambda-form-entry (cons read (lambda Y1029 (read Y1029)))) (do (shen.set-lambda-form-entry (cons remove (lambda Y1023 (lambda Y1024 (remove Y1023 Y1024))))) (do (shen.set-lambda-form-entry (cons reverse (lambda Y1022 (reverse Y1022)))) (do (shen.set-lambda-form-entry (cons set (lambda Y1020 (lambda Y1021 (set Y1020 Y1021))))) (do (shen.set-lambda-form-entry (cons simple-error (lambda Y1019 (simple-error Y1019)))) (do (shen.set-lambda-form-entry (cons snd (lambda Y1018 (snd Y1018)))) (do (shen.set-lambda-form-entry (cons str (lambda Y1013 (str Y1013)))) (do (shen.set-lambda-form-entry (cons string->n (lambda Y1012 (string->n Y1012)))) (do (shen.set-lambda-form-entry (cons subst (lambda Y1007 (lambda Y1008 (lambda Y1009 (subst Y1007 Y1008 Y1009)))))) (do (shen.set-lambda-form-entry (cons symbol? (lambda Y1005 (symbol? Y1005)))) (do (shen.set-lambda-form-entry (cons tail (lambda Y1003 (tail Y1003)))) (do (shen.set-lambda-form-entry (cons tl (lambda Y1002 (tl Y1002)))) (do (shen.set-lambda-form-entry (cons thaw (lambda Y1000 (thaw Y1000)))) (do (shen.set-lambda-form-entry (cons tlstr (lambda Y999 (tlstr Y999)))) (do (shen.set-lambda-form-entry (cons trap-error (lambda Y996 (lambda Y997 (trap-error Y996 Y997))))) (do (shen.set-lambda-form-entry (cons tuple? (lambda Y995 (tuple? Y995)))) (do (shen.set-lambda-form-entry (cons return (lambda Y988 (lambda Y989 (lambda Y990 (lambda Y991 (lambda Y992 (return Y988 Y989 Y990 Y991 Y992)))))))) (do (shen.set-lambda-form-entry (cons unput (lambda Y983 (lambda Y984 (lambda Y985 (unput Y983 Y984 Y985)))))) (do (shen.set-lambda-form-entry (cons union (lambda Y980 (lambda Y981 (union Y980 Y981))))) (do (shen.set-lambda-form-entry (cons vector (lambda Y975 (vector Y975)))) (do (shen.set-lambda-form-entry (cons vector? (lambda Y974 (vector? Y974)))) (do (shen.set-lambda-form-entry (cons vector-> (lambda Y971 (lambda Y972 (lambda Y973 (vector-> Y971 Y972 Y973)))))) (do (shen.set-lambda-form-entry (cons value (lambda Y970 (value Y970)))) (do (shen.set-lambda-form-entry (cons variable? (lambda Y969 (variable? Y969)))) (do (shen.set-lambda-form-entry (cons when (lambda Y959 (lambda Y960 (lambda Y961 (lambda Y962 (lambda Y963 (when Y959 Y960 Y961 Y962 Y963)))))))) (do (shen.set-lambda-form-entry (cons y-or-n? (lambda Y954 (y-or-n? Y954)))) (do (shen.set-lambda-form-entry (cons + (lambda Y952 (lambda Y953 (+ Y952 Y953))))) (do (shen.set-lambda-form-entry (cons * (lambda Y950 (lambda Y951 (* Y950 Y951))))) (do (shen.set-lambda-form-entry (cons / (lambda Y948 (lambda Y949 (/ Y948 Y949))))) (do (shen.set-lambda-form-entry (cons - (lambda Y946 (lambda Y947 (- Y946 Y947))))) (do (shen.set-lambda-form-entry (cons (lambda Y943 ( Y943)))) (do (shen.set-lambda-form-entry (cons (lambda Y942 ( Y942)))) (do (shen.set-lambda-form-entry (cons (lambda Y941 ( Y941)))) (do (shen.set-lambda-form-entry (cons @p (lambda Y939 (lambda Y940 (@p Y939 Y940))))) (do (shen.set-lambda-form-entry (cons @v (lambda Y937 (lambda Y938 (@v Y937 Y938))))) (shen.set-lambda-form-entry (cons @s (lambda Y935 (lambda Y936 (@s Y935 Y936))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) + +(defun shen.initialise () (do (shen.initialise-environment) (do (shen.initialise-lambda-forms) (shen.initialise-signedfuncs)))) + +(defun max (V310 V311) (cond ((> V311 V310) V311) (true V310))) + +(defun gcd (V336 V337) (if (and (integer? V336) (integer? V337)) (let W338 (abs V336) (let W339 (abs V337) (if (> W338 W339) (maths.gcd-help (- W338 W339) W339) (maths.gcd-help W338 (- W339 W338))))) (simple-error "gcd expects integer inputs"))) + +(defun maths.gcd-help (V342 V343) (if (> V342 V343) (maths.gcd-loop V342 V343 V343) (maths.gcd-loop V342 V343 V342))) + +(defun maths.gcd-loop (V350 V351 V352) (cond ((= 1 V352) 1) ((and (integer? (/ V350 V352)) (integer? (/ V351 V352))) V352) (true (maths.gcd-loop V350 V351 (- V352 1))))) + +(defun abs (V505) (if (>= V505 0) V505 (- 0 V505))) + +(defun filter (V1414 V1415) (cond ((= () V1415) ()) ((cons? V1415) (if (V1414 (hd V1415)) (cons (hd V1415) (filter V1414 (tl V1415))) (filter V1414 (tl V1415)))) (true (shen.f-error filter)))) + +(defun digit? (V1799) (cond ((shen.+string? V1799) (let W1800 (string->n (hdstr V1799)) (and (> W1800 47) (< W1800 58)))) (true (shen.f-error digit?)))) + diff --git a/crates/shenffi/include/shenffi.h b/crates/shenffi/include/shenffi.h new file mode 100644 index 0000000..051ab02 --- /dev/null +++ b/crates/shenffi/include/shenffi.h @@ -0,0 +1,50 @@ +/* shenffi.h — C ABI for embedding shen-rust (Shen language) in a host app. */ +#ifndef SHENFFI_H +#define SHENFFI_H + +#ifdef __cplusplus +extern "C" { +#endif + +/* Opaque handle to a booted Shen image. */ +typedef struct ShenCtx ShenCtx; + +/* Boot a Shen kernel. Pass NULL for kernel_dir to auto-locate the vendored + * kernel, or an absolute path to a directory of .kl files. Returns NULL on + * failure. Free with shen_free(). */ +ShenCtx *shen_boot(const char *kernel_dir); + +/* Boot the full kernel from sources embedded in the binary — no filesystem + * access. Recommended on iOS. Returns NULL on failure; free with shen_free(). */ +ShenCtx *shen_boot_embedded(void); + +/* Evaluate a Shen expression; returns a heap-allocated C string (the rendered + * result, or "error: "). Release it with shen_string_free(). */ +char *shen_eval(ShenCtx *ctx, const char *src); + +/* Boot any Ratatoskr-shaken program from a shaken kernel.kl slice + optional + * program .kl (pass NULL prog_kl for kernel-only). The program is loaded with + * *hush* set, so its load-time stdout chatter is suppressed. Free with + * shen_free(). */ +ShenCtx *shen_boot_shaken(const char *kernel_kl, const char *prog_kl); + +/* --- shen-cas: embedded, tree-shaken computer algebra system --- */ + +/* Boot the embedded shen-cas slice. Free with shen_free(). */ +ShenCtx *shen_cas_boot(void); + +/* Parse + reduce + pretty-print a CAS expression, e.g. "D[Sin[x],x]" -> "[Cos x]". + * Returns a heap string; release with shen_string_free(). */ +char *shen_cas_reduce(ShenCtx *ctx, const char *src); + +/* Free a string returned by shen_eval() / shen_cas_reduce(). */ +void shen_string_free(char *s); + +/* Free a handle returned by shen_boot(). */ +void shen_free(ShenCtx *ctx); + +#ifdef __cplusplus +} +#endif + +#endif /* SHENFFI_H */ diff --git a/crates/shenffi/src/lib.rs b/crates/shenffi/src/lib.rs new file mode 100644 index 0000000..9e89291 --- /dev/null +++ b/crates/shenffi/src/lib.rs @@ -0,0 +1,325 @@ +//! C-ABI bindings for embedding shen-rust in non-Rust hosts (Swift / iOS). +//! +//! The whole surface is four functions: +//! +//! ```c +//! ShenCtx *shen_boot(const char *kernel_dir); // NULL dir -> auto-locate +//! char *shen_eval(ShenCtx *ctx, const char *src); +//! void shen_string_free(char *s); +//! void shen_free(ShenCtx *ctx); +//! ``` +//! +//! `shen_eval` evaluates a *Shen-level* expression (not raw KLambda) by driving +//! the kernel's own pipeline — `read-from-string` -> `head` -> `eval` — and then +//! rendering the result to a string with `shen.app`. The returned C string is +//! heap-allocated by Rust and must be released with `shen_string_free`. + +use std::ffi::{CStr, CString}; +use std::os::raw::c_char; +use std::path::PathBuf; + +use shen_rust::interp::boot::{boot, boot_from_kl_source, boot_with_kernel, eval_kl_source}; +use shen_rust::interp::eval::Interp; +use shen_rust::value::Value; + +/// Opaque handle to a booted Shen image. +pub struct ShenCtx { + interp: Interp, +} + +/// The ShenOSKernel-41.2 `.kl` sources, embedded into the binary at compile +/// time in shen-rust's load order. Lets `shen_boot_embedded` bring up the full +/// kernel with **no filesystem access** — the iOS-friendly path (no bundled +/// resources, no sandbox path juggling). +const KERNEL_PARTS: &[&str] = &[ + include_str!("../../../kernel/klambda/core.kl"), + include_str!("../../../kernel/klambda/toplevel.kl"), + include_str!("../../../kernel/klambda/sys.kl"), + include_str!("../../../kernel/klambda/reader.kl"), + include_str!("../../../kernel/klambda/prolog.kl"), + include_str!("../../../kernel/klambda/load.kl"), + include_str!("../../../kernel/klambda/writer.kl"), + include_str!("../../../kernel/klambda/macros.kl"), + include_str!("../../../kernel/klambda/declarations.kl"), + include_str!("../../../kernel/klambda/types.kl"), + include_str!("../../../kernel/klambda/t-star.kl"), + include_str!("../../../kernel/klambda/sequent.kl"), + include_str!("../../../kernel/klambda/track.kl"), + include_str!("../../../kernel/klambda/dict.kl"), + include_str!("../../../kernel/klambda/compiler.kl"), + include_str!("../../../kernel/klambda/stlib.kl"), + include_str!("../../../kernel/klambda/init.kl"), + include_str!("../../../kernel/klambda/extension-features.kl"), + include_str!("../../../kernel/klambda/extension-expand-dynamic.kl"), + include_str!("../../../kernel/klambda/extension-launcher.kl"), + include_str!("../../../kernel/klambda/yacc.kl"), +]; + +/// Boots a Shen kernel and returns an owning handle, or NULL on failure. +/// +/// `kernel_dir` is an optional path to a directory of `.kl` kernel files; pass +/// NULL to let shen-rust auto-locate its vendored kernel. +/// +/// # Safety +/// `kernel_dir` must be NULL or a valid NUL-terminated C string. +#[no_mangle] +pub extern "C" fn shen_boot(kernel_dir: *const c_char) -> *mut ShenCtx { + let mut interp = Interp::new(); + let result = if kernel_dir.is_null() { + boot(&mut interp) + } else { + let dir = unsafe { CStr::from_ptr(kernel_dir) } + .to_string_lossy() + .into_owned(); + boot_with_kernel(&mut interp, &PathBuf::from(dir)) + }; + match result { + Ok(()) => Box::into_raw(Box::new(ShenCtx { interp })), + Err(_) => std::ptr::null_mut(), + } +} + +/// Boots the full kernel from the **embedded** `.kl` sources — no filesystem +/// access at all. This is the recommended entry point on iOS. Returns NULL on +/// failure; free with `shen_free`. +#[no_mangle] +pub extern "C" fn shen_boot_embedded() -> *mut ShenCtx { + let mut interp = Interp::new(); + let src = KERNEL_PARTS.join("\n"); + match boot_from_kl_source(&mut interp, &src, Some(shen_rust::aot::kernel::install_all)) { + Ok(()) => Box::into_raw(Box::new(ShenCtx { interp })), + Err(_) => std::ptr::null_mut(), + } +} + +// --- shen-cas: a tree-shaken computer-algebra system embedded in the binary --- +// +// Produced by `ratatoskr shake` over the flattened shen-cas sources: a minimal +// kernel slice (only what the CAS reaches) plus the CAS compiled to KLambda. +// Demonstrates the full pipeline: Shen program -> ratatoskr tree-shake -> Rust +// static lib -> Swift. No Shen-level `eval` needed; we call the CAS's own +// functions (`parse-expr-string` -> `reduce` -> `pretty-expr`) directly. +const CAS_KERNEL: &str = include_str!("../cas/cas-kernel.kl"); +const CAS_PROG: &str = include_str!("../cas/cas-all.kl"); + +/// Boots any Ratatoskr-shaken program: a shaken `kernel.kl` slice plus an +/// optional program `.kl`. Pass NULL `prog_kl` for kernel-only. +/// +/// Follows the builder contract — boot the kernel and run `(shen.initialise)` +/// first, then load the program (whose top-level forms need the initialised +/// environment). The program load runs with `*hush*` set, so the program's own +/// "…loaded" chatter to stdout is suppressed (file writes still happen). +/// +/// # Safety +/// `kernel_kl` must be a valid C string; `prog_kl` NULL or a valid C string. +#[no_mangle] +pub extern "C" fn shen_boot_shaken( + kernel_kl: *const c_char, + prog_kl: *const c_char, +) -> *mut ShenCtx { + if kernel_kl.is_null() { + return std::ptr::null_mut(); + } + let kernel = unsafe { CStr::from_ptr(kernel_kl) }.to_string_lossy().into_owned(); + let prog = if prog_kl.is_null() { + None + } else { + Some(unsafe { CStr::from_ptr(prog_kl) }.to_string_lossy().into_owned()) + }; + match boot_shaken_inner(&kernel, prog.as_deref()) { + Ok(interp) => Box::into_raw(Box::new(ShenCtx { interp })), + Err(e) => { + eprintln!("shen_boot_shaken error: {e}"); + std::ptr::null_mut() + } + } +} + +fn boot_shaken_inner(kernel: &str, prog: Option<&str>) -> Result { + let mut interp = Interp::new(); + boot_from_kl_source(&mut interp, kernel, None).map_err(|e| e.to_string())?; + if let Some(p) = prog { + // Silence the program's load-time stdout messages (e.g. shen-cas's + // "…loaded" lines). shen-rust's `pr` honours `*hush*` for stdout only, + // so file writes during load are unaffected. Restore afterward. + let hush = interp.intern("*hush*"); + interp.env.set_global(hush, Value::bool(true)); + let r = eval_kl_source(&mut interp, p, "shaken program", &[]).map_err(|e| e.to_string()); + interp.env.set_global(hush, Value::bool(false)); + r?; + } + Ok(interp) +} + +/// Boots the embedded shen-cas slice (shaken kernel + CAS), tree-walked. +#[no_mangle] +pub extern "C" fn shen_cas_boot() -> *mut ShenCtx { + match boot_shaken_inner(CAS_KERNEL, Some(CAS_PROG)) { + Ok(interp) => Box::into_raw(Box::new(ShenCtx { interp })), + Err(e) => { + eprintln!("shen_cas_boot error: {e}"); + std::ptr::null_mut() + } + } +} + +/// Parses, reduces, and pretty-prints one CAS expression (e.g. "D[Sin[x],x]"). +/// Returns the normal form rendered as a string ("error: …" on failure). +/// +/// # Safety +/// `ctx` must be a `shen_cas_boot` handle and `src` a valid C string. +#[no_mangle] +pub extern "C" fn shen_cas_reduce(ctx: *mut ShenCtx, src: *const c_char) -> *mut c_char { + if ctx.is_null() || src.is_null() { + return std::ptr::null_mut(); + } + let ctx = unsafe { &mut *ctx }; + let input = unsafe { CStr::from_ptr(src) }.to_string_lossy().into_owned(); + let out = match cas_reduce(&mut ctx.interp, &input) { + Ok(s) => s, + Err(e) => format!("error: {e}"), + }; + CString::new(out) + .unwrap_or_else(|_| CString::new("").unwrap()) + .into_raw() +} + +fn cas_reduce(interp: &mut Interp, input: &str) -> Result { + let parse_sym = interp.intern("parse-expr-string"); + let reduce_sym = interp.intern("reduce"); + let pretty_sym = interp.intern("pretty-expr"); + let app_sym = interp.intern("shen.app"); + let mode = Value::sym(interp.intern("shen.s")); + + let parse_fn = interp + .env + .get_fn(parse_sym) + .cloned() + .ok_or_else(|| "parse-expr-string is undefined".to_string())?; + let ast = interp + .apply(parse_fn, vec![Value::str(input)]) + .map_err(|e| e.to_string())?; + + let reduce_fn = interp + .env + .get_fn(reduce_sym) + .cloned() + .ok_or_else(|| "reduce is undefined".to_string())?; + let nf = interp.apply(reduce_fn, vec![ast]).map_err(|e| e.to_string())?; + + let pretty_fn = interp + .env + .get_fn(pretty_sym) + .cloned() + .ok_or_else(|| "pretty-expr is undefined".to_string())?; + let pretty = interp.apply(pretty_fn, vec![nf]).map_err(|e| e.to_string())?; + + let app_fn = interp + .env + .get_fn(app_sym) + .cloned() + .ok_or_else(|| "shen.app is undefined".to_string())?; + let rendered = interp + .apply(app_fn, vec![pretty, Value::str(""), mode]) + .map_err(|e| e.to_string())?; + + rendered + .as_str() + .map(|s| s.to_string()) + .ok_or_else(|| "CAS result did not render to a string".to_string()) +} + +/// Evaluates a Shen expression and returns its rendered value as a freshly +/// allocated C string (release with `shen_string_free`). On error the string is +/// `"error: "`. Returns NULL only if the arguments are NULL. +/// +/// # Safety +/// `ctx` must be a handle from `shen_boot` (not yet freed) and `src` a valid +/// NUL-terminated C string. +#[no_mangle] +pub extern "C" fn shen_eval(ctx: *mut ShenCtx, src: *const c_char) -> *mut c_char { + if ctx.is_null() || src.is_null() { + return std::ptr::null_mut(); + } + let ctx = unsafe { &mut *ctx }; + let src = unsafe { CStr::from_ptr(src) }.to_string_lossy().into_owned(); + let out = match eval_shen(&mut ctx.interp, &src) { + Ok(s) => s, + Err(e) => format!("error: {e}"), + }; + // CString::new fails only on interior NULs; fall back to empty in that case. + CString::new(out) + .unwrap_or_else(|_| CString::new("").unwrap()) + .into_raw() +} + +/// Releases a string returned by `shen_eval`. +/// +/// # Safety +/// `s` must be NULL or a pointer previously returned by `shen_eval`. +#[no_mangle] +pub extern "C" fn shen_string_free(s: *mut c_char) { + if !s.is_null() { + unsafe { drop(CString::from_raw(s)) }; + } +} + +/// Releases a handle returned by `shen_boot`. +/// +/// # Safety +/// `ctx` must be NULL or a handle from `shen_boot` that has not been freed. +#[no_mangle] +pub extern "C" fn shen_free(ctx: *mut ShenCtx) { + if !ctx.is_null() { + unsafe { drop(Box::from_raw(ctx)) }; + } +} + +/// Evaluate one Shen-level expression and render the result to a string, +/// entirely through kernel functions so the semantics match the REPL. +fn eval_shen(interp: &mut Interp, src: &str) -> Result { + // Intern every symbol up front (mutable borrow), then resolve + apply each + // kernel function in turn (the get_fn borrow ends at each `.cloned()`). + let read_sym = interp.intern("read-from-string"); + let head_sym = interp.intern("head"); + let eval_sym = interp.intern("eval"); + let app_sym = interp.intern("shen.app"); + let mode = Value::sym(interp.intern("shen.s")); + + let read_fn = interp + .env + .get_fn(read_sym) + .cloned() + .ok_or_else(|| "read-from-string is undefined".to_string())?; + let forms = interp + .apply(read_fn, vec![Value::str(src)]) + .map_err(|e| e.to_string())?; + + let head_fn = interp + .env + .get_fn(head_sym) + .cloned() + .ok_or_else(|| "head is undefined".to_string())?; + let first = interp.apply(head_fn, vec![forms]).map_err(|e| e.to_string())?; + + let eval_fn = interp + .env + .get_fn(eval_sym) + .cloned() + .ok_or_else(|| "eval is undefined".to_string())?; + let result = interp.apply(eval_fn, vec![first]).map_err(|e| e.to_string())?; + + let app_fn = interp + .env + .get_fn(app_sym) + .cloned() + .ok_or_else(|| "shen.app is undefined".to_string())?; + let rendered = interp + .apply(app_fn, vec![result, Value::str(""), mode]) + .map_err(|e| e.to_string())?; + + rendered + .as_str() + .map(|s| s.to_string()) + .ok_or_else(|| "result did not render to a string".to_string()) +} diff --git a/crates/shenffi/swift/ShenRust.swift b/crates/shenffi/swift/ShenRust.swift new file mode 100644 index 0000000..a947330 --- /dev/null +++ b/crates/shenffi/swift/ShenRust.swift @@ -0,0 +1,35 @@ +import Foundation + +/// Swift wrapper around the shenffi C ABI: a booted, embedded Shen interpreter. +/// +/// The C functions (`shen_boot`, `shen_eval`, ...) are exposed to Swift via the +/// `shenffi.h` bridging header. +public final class ShenRust { + public enum Failure: Error { case bootFailed } + + private let ctx: OpaquePointer + + /// Boots a Shen image. + /// + /// Pass `nil` (the default) to boot from the kernel sources embedded in the + /// binary — no filesystem access, the recommended path on iOS. Pass a + /// directory of `.kl` files to boot from disk instead. + public init(kernelDir: String? = nil) throws { + let handle: OpaquePointer? = kernelDir.map { dir in + dir.withCString { shen_boot($0) } + } ?? shen_boot_embedded() + guard let handle else { throw Failure.bootFailed } + ctx = handle + } + + /// Evaluates a Shen expression and returns its rendered result (or an + /// `"error: …"` string if evaluation failed). + @discardableResult + public func eval(_ source: String) -> String { + guard let out = source.withCString({ shen_eval(ctx, $0) }) else { return "" } + defer { shen_string_free(out) } + return String(cString: out) + } + + deinit { shen_free(ctx) } +} diff --git a/crates/shenffi/swift/cas-demo.swift b/crates/shenffi/swift/cas-demo.swift new file mode 100644 index 0000000..7efbf5b --- /dev/null +++ b/crates/shenffi/swift/cas-demo.swift @@ -0,0 +1,34 @@ +import Foundation + +// Swift -> Rust -> (tree-shaken) shen-cas computer algebra system. +// +// The CAS reducer is deeply recursive and runs tree-walked, so drive it on a +// thread with a large stack (the shen-rust CLI does the same). In an app, call +// the FFI from a dedicated big-stack background thread. + +final class CASRunner: Thread { + override func main() { + guard let ctx = shen_cas_boot() else { + FileHandle.standardError.write(Data("cas boot failed\n".utf8)) + Foundation.exit(1) + } + defer { shen_free(ctx) } + + func cas(_ s: String) -> String { + guard let out = s.withCString({ shen_cas_reduce(ctx, $0) }) else { return "" } + defer { shen_string_free(out) } + return String(cString: out) + } + + print("--- shen-cas (embedded in Rust, called from Swift) ---") + for expr in ["2 + 3", "6/4", "a+b*c", "Sin[x]", "D[Sin[x],x]", "D[x^3,x]", "D[Exp[x],x]"] { + print("\(expr) => \(cas(expr))") + } + Foundation.exit(0) + } +} + +let runner = CASRunner() +runner.stackSize = 512 * 1024 * 1024 +runner.start() +while !runner.isFinished { Thread.sleep(forTimeInterval: 0.02) } diff --git a/crates/shenffi/swift/main.swift b/crates/shenffi/swift/main.swift new file mode 100644 index 0000000..8d56d82 --- /dev/null +++ b/crates/shenffi/swift/main.swift @@ -0,0 +1,25 @@ +import Foundation + +// Demonstrates the Swift -> Rust -> Shen round-trip via the ShenRust wrapper. +// Usage: demo [kernel-dir] (kernel-dir optional; nil auto-locates) + +let kernelDir = CommandLine.arguments.count > 1 ? CommandLine.arguments[1] : nil + +do { + let shen = try ShenRust(kernelDir: kernelDir) + let exprs = [ + "(+ 1 2)", + "(* 6 7)", + "(append [1 2 3] [4 5 6])", + "(map (/. X (* X X)) [1 2 3 4])", + "(+ 1 2.5)", + "(reverse [a b c])", + "(if (> 3 2) yes no)", + ] + for e in exprs { + print("\(e) => \(shen.eval(e))") + } +} catch { + FileHandle.standardError.write(Data("boot failed: \(error)\n".utf8)) + exit(1) +} From c40173996d943525ab25b91979b4f8a8eb8f59e9 Mon Sep 17 00:00:00 2001 From: Reuben Brooks Date: Sat, 20 Jun 2026 21:31:37 -0500 Subject: [PATCH 2/7] Add macos-arm64 slice to ShenRust.xcframework build Lets a native macOS app embed the same CAS. Unlike the iOS simulator, MLX/Metal runs on Apple-silicon macOS, so the on-device model is exercisable there. Co-Authored-By: Claude Opus 4.8 --- crates/shenffi/build-xcframework.sh | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) diff --git a/crates/shenffi/build-xcframework.sh b/crates/shenffi/build-xcframework.sh index c52738d..02d8630 100755 --- a/crates/shenffi/build-xcframework.sh +++ b/crates/shenffi/build-xcframework.sh @@ -1,13 +1,17 @@ #!/usr/bin/env bash -# Build ShenRust.xcframework (iOS device + simulator) from the shenffi crate. -# Output: /target/ShenRust.xcframework — drag into an Xcode app, +# Build ShenRust.xcframework (iOS device + simulator + macOS) from the shenffi +# crate. Output: /target/ShenRust.xcframework — drag into an Xcode app, # add the bridging header (shenffi.h) + ShenRust.swift, and you're done. +# +# The macOS slice (aarch64-apple-darwin) lets a native macOS target embed the +# same CAS — and, unlike the iOS simulator, MLX/Metal runs there, so the +# on-device model is exercisable on an Apple-silicon Mac. set -euo pipefail cd "$(dirname "$0")/../.." # workspace root (shen-rust/) HDRS="crates/shenffi/include" -for tgt in aarch64-apple-ios aarch64-apple-ios-sim; do +for tgt in aarch64-apple-ios aarch64-apple-ios-sim aarch64-apple-darwin; do rustup target add "$tgt" >/dev/null 2>&1 || true echo "building shenffi for $tgt ..." cargo build --release -p shenffi --target "$tgt" @@ -18,6 +22,7 @@ rm -rf target/ShenRust.xcframework xcodebuild -create-xcframework \ -library target/aarch64-apple-ios/release/libshenffi.a -headers "$HDRS" \ -library target/aarch64-apple-ios-sim/release/libshenffi.a -headers "$HDRS" \ + -library target/aarch64-apple-darwin/release/libshenffi.a -headers "$HDRS" \ -output target/ShenRust.xcframework echo "done -> target/ShenRust.xcframework" From 6826d32d8f14c6173ea624c9cd3af8bbc3e04645 Mon Sep 17 00:00:00 2001 From: Reuben Brooks Date: Sat, 20 Jun 2026 21:45:03 -0500 Subject: [PATCH 3/7] Add shencalc-iced: pure-Rust native calculator GUI over shen-cas MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit A native, cross-platform (Mac/Win/Linux) desktop calculator built on iced 0.14 that talks straight to the embedded CAS — no FFI, no Swift, no MLX. This is the Syntax-mode MVP; English mode (a small local model via candle mapping NL → the CAS tool grammar) is the planned next layer. - shenffi: expose a safe Rust `CasEngine { boot, reduce }` over the existing private boot_shaken_inner/cas_reduce helpers, so Rust hosts can embed the CAS as an rlib without the C-ABI raw pointers. - crates/shencalc-iced: the iced app. The deeply-recursive tree-walked reducer runs on a dedicated 64 MB-stack worker thread (the default 8 MB overflows on boot, matching ShenCAS.swift); the UI talks to it over channels and stays responsive. A `--selftest` flag reduces a fixed battery headlessly (no display) for CI. Verified: builds on iced 0.14; `--selftest` reduces D/Integrate/Factor/ Solve/Expand/arithmetic correctly; the GUI window launches cleanly. Known gap: shows the raw CAS form ([Cos x]) — the human pretty-printer (MathPretty.swift) is Swift-only and still needs a Rust port. Co-Authored-By: Claude Opus 4.8 --- Cargo.lock | 4559 ++++++++++++++++++++++++++---- Cargo.toml | 1 + crates/shencalc-iced/Cargo.toml | 14 + crates/shencalc-iced/src/main.rs | 283 ++ crates/shenffi/src/lib.rs | 63 +- 5 files changed, 4287 insertions(+), 633 deletions(-) create mode 100644 crates/shencalc-iced/Cargo.toml create mode 100644 crates/shencalc-iced/src/main.rs diff --git a/Cargo.lock b/Cargo.lock index 2aeda5b..9d609c9 100644 --- a/Cargo.lock +++ b/Cargo.lock @@ -2,6 +2,35 @@ # It is not intended for manual editing. version = 4 +[[package]] +name = "ab_glyph" +version = "0.2.32" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "01c0457472c38ea5bd1c3b5ada5e368271cb550be7a4ca4a0b4634e9913f6cc2" +dependencies = [ + "ab_glyph_rasterizer", + "owned_ttf_parser", +] + +[[package]] +name = "ab_glyph_rasterizer" +version = "0.1.10" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "366ffbaa4442f4684d91e2cd7c5ea7c4ed8add41959a31447066e279e432b618" + +[[package]] +name = "ahash" +version = "0.8.12" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "5a15f179cd60c4584b8a8c596927aadc462e27f2ca70c04e0071964a73ba7a75" +dependencies = [ + "cfg-if", + "getrandom 0.3.4", + "once_cell", + "version_check", + "zerocopy", +] + [[package]] name = "aho-corasick" version = "1.1.4" @@ -17,6 +46,40 @@ version = "0.2.21" source = "registry+https://github.com/rust-lang/crates.io-index" checksum = "683d7910e743518b0e34f1186f92494becacb047c7b6bf616c96772180fef923" +[[package]] +name = "android-activity" +version = "0.6.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "0f2a1bb052857d5dd49572219344a7332b31b76405648eabac5bc68978251bcd" +dependencies = [ + "android-properties", + "bitflags 2.11.1", + "cc", + "jni", + "libc", + "log", + "ndk", + "ndk-context", + "ndk-sys", + "num_enum", + "thiserror 2.0.18", +] + +[[package]] +name = "android-build" +version = "0.1.4" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "f9fc9904ad2ad097c3c1cfe2eacaaf0fc24710936fa9ed941cb310b7c6ed2ab7" +dependencies = [ + "windows-sys 0.52.0", +] + +[[package]] +name = "android-properties" +version = "0.2.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "fc7eb209b1518d6bb87b283c20095f5228ecda460da70b44f0802523dea6da04" + [[package]] name = "android_system_properties" version = "0.1.5" @@ -47,12 +110,30 @@ version = "1.4.2" source = "registry+https://github.com/rust-lang/crates.io-index" checksum = "c3d036a3c4ab069c7b410a2ce876bd74808d2d0888a82667669f8e783a898bf1" +[[package]] +name = "arrayref" +version = "0.3.9" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "76a2e8124351fda1ef8aaaa3bbd7ebbcb486bbcd4225aca0aa0d84bb2db8fecb" + [[package]] name = "arrayvec" version = "0.5.2" source = "registry+https://github.com/rust-lang/crates.io-index" checksum = "23b62fc65de8e4e7f52534fb52b0f3ed04746ae267519eef2a83941e8085068b" +[[package]] +name = "arrayvec" +version = "0.7.7" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "f02882884d3e1bc524fb12c79f107f6ad0e1cfd498c536ffb494301740995dfe" + +[[package]] +name = "as-raw-xcb-connection" +version = "1.0.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "175571dd1d178ced59193a6fc02dde1b972eb0bc56c892cde9beeceac5bf0f6b" + [[package]] name = "ascii-canvas" version = "4.0.0" @@ -62,6 +143,152 @@ dependencies = [ "term", ] +[[package]] +name = "ash" +version = "0.38.0+1.3.281" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "0bb44936d800fea8f016d7f2311c6a4f97aebd5dc86f09906139ec848cf3a46f" +dependencies = [ + "libloading", +] + +[[package]] +name = "async-broadcast" +version = "0.7.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "435a87a52755b8f27fcf321ac4f04b2802e337c8c4872923137471ec39c37532" +dependencies = [ + "event-listener", + "event-listener-strategy", + "futures-core", + "pin-project-lite", +] + +[[package]] +name = "async-channel" +version = "2.5.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "924ed96dd52d1b75e9c1a3e6275715fd320f5f9439fb5a4a11fa51f4221158d2" +dependencies = [ + "concurrent-queue", + "event-listener-strategy", + "futures-core", + "pin-project-lite", +] + +[[package]] +name = "async-executor" +version = "1.14.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "c96bf972d85afc50bf5ab8fe2d54d1586b4e0b46c97c50a0c9e71e2f7bcd812a" +dependencies = [ + "async-task", + "concurrent-queue", + "fastrand", + "futures-lite", + "pin-project-lite", + "slab", +] + +[[package]] +name = "async-io" +version = "2.6.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "456b8a8feb6f42d237746d4b3e9a178494627745c3c56c6ea55d92ba50d026fc" +dependencies = [ + "autocfg", + "cfg-if", + "concurrent-queue", + "futures-io", + "futures-lite", + "parking", + "polling", + "rustix 1.1.4", + "slab", + "windows-sys 0.61.2", +] + +[[package]] +name = "async-lock" +version = "3.4.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "290f7f2596bd5b78a9fec8088ccd89180d7f9f55b94b0576823bbbdc72ee8311" +dependencies = [ + "event-listener", + "event-listener-strategy", + "pin-project-lite", +] + +[[package]] +name = "async-process" +version = "2.5.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "fc50921ec0055cdd8a16de48773bfeec5c972598674347252c0399676be7da75" +dependencies = [ + "async-channel", + "async-io", + "async-lock", + "async-signal", + "async-task", + "blocking", + "cfg-if", + "event-listener", + "futures-lite", + "rustix 1.1.4", +] + +[[package]] +name = "async-recursion" +version = "1.1.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "3b43422f69d8ff38f95f1b2bb76517c91589a924d1559a0e935d7c8ce0274c11" +dependencies = [ + "proc-macro2", + "quote", + "syn", +] + +[[package]] +name = "async-signal" +version = "0.2.14" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "52b5aaafa020cf5053a01f2a60e8ff5dccf550f0f77ec54a4e47285ac2bab485" +dependencies = [ + "async-io", + "async-lock", + "atomic-waker", + "cfg-if", + "futures-core", + "futures-io", + "rustix 1.1.4", + "signal-hook-registry", + "slab", + "windows-sys 0.61.2", +] + +[[package]] +name = "async-task" +version = "4.7.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "8b75356056920673b02621b35afd0f7dda9306d03c79a30f5c56c44cf256e3de" + +[[package]] +name = "async-trait" +version = "0.1.89" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "9035ad2d096bed7955a320ee7e2230574d28fd3c3a0f186cbea1ff3c7eed5dbb" +dependencies = [ + "proc-macro2", + "quote", + "syn", +] + +[[package]] +name = "atomic-waker" +version = "1.1.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "1505bd5d3d116872e7271a6d4e16d81d0c8570876c8de68093a09ac269d8aac0" + [[package]] name = "autocfg" version = "1.5.1" @@ -101,6 +328,12 @@ version = "2.11.1" source = "registry+https://github.com/rust-lang/crates.io-index" checksum = "c4512299f36f043ab09a583e57bceb5a5aab7a73db1805848e8fef3c9e8c78b3" +[[package]] +name = "block" +version = "0.1.6" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "0d8c1fef690941d3e7788d328517591fecc684c084084702d6ff1641e993699a" + [[package]] name = "block-buffer" version = "0.10.4" @@ -110,6 +343,37 @@ dependencies = [ "generic-array", ] +[[package]] +name = "block2" +version = "0.5.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "2c132eebf10f5cad5289222520a4a058514204aed6d791f1cf4fe8088b82d15f" +dependencies = [ + "objc2 0.5.2", +] + +[[package]] +name = "block2" +version = "0.6.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "cdeb9d870516001442e364c5220d3574d2da8dc765554b4a617230d33fa58ef5" +dependencies = [ + "objc2 0.6.4", +] + +[[package]] +name = "blocking" +version = "1.6.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "e83f8d02be6967315521be875afa792a316e28d57b5a2d401897e2a7921b7f21" +dependencies = [ + "async-channel", + "async-task", + "futures-io", + "futures-lite", + "piper", +] + [[package]] name = "borsh" version = "1.6.1" @@ -138,12 +402,83 @@ dependencies = [ "allocator-api2", ] +[[package]] +name = "bytemuck" +version = "1.25.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "c8efb64bd706a16a1bdde310ae86b351e4d21550d98d056f22f8a7f7a2183fec" +dependencies = [ + "bytemuck_derive", +] + +[[package]] +name = "bytemuck_derive" +version = "1.10.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "f9abbd1bc6865053c427f7198e6af43bfdedc55ab791faed4fbd361d789575ff" +dependencies = [ + "proc-macro2", + "quote", + "syn", +] + [[package]] name = "bytes" version = "1.11.1" source = "registry+https://github.com/rust-lang/crates.io-index" checksum = "1e748733b7cbc798e1434b6ac524f0c1ff2ab456fe201501e6497c8417a4fc33" +[[package]] +name = "calloop" +version = "0.13.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "b99da2f8558ca23c71f4fd15dc57c906239752dd27ff3c00a1d56b685b7cbfec" +dependencies = [ + "bitflags 2.11.1", + "log", + "polling", + "rustix 0.38.44", + "slab", + "thiserror 1.0.69", +] + +[[package]] +name = "calloop" +version = "0.14.4" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "4dbf9978365bac10f54d1d4b04f7ce4427e51f71d61f2fe15e3fed5166474df7" +dependencies = [ + "bitflags 2.11.1", + "polling", + "rustix 1.1.4", + "slab", + "tracing", +] + +[[package]] +name = "calloop-wayland-source" +version = "0.3.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "95a66a987056935f7efce4ab5668920b5d0dac4a7c99991a67395f13702ddd20" +dependencies = [ + "calloop 0.13.0", + "rustix 0.38.44", + "wayland-backend", + "wayland-client", +] + +[[package]] +name = "calloop-wayland-source" +version = "0.4.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "138efcf0940a02ebf0cc8d1eff41a1682a46b431630f4c52450d6265876021fa" +dependencies = [ + "calloop 0.14.4", + "rustix 1.1.4", + "wayland-backend", + "wayland-client", +] + [[package]] name = "cc" version = "1.2.62" @@ -151,6 +486,8 @@ source = "registry+https://github.com/rust-lang/crates.io-index" checksum = "a1dce859f0832a7d088c4f1119888ab94ef4b5d6795d1ce05afb7fe159d79f98" dependencies = [ "find-msvc-tools", + "jobserver", + "libc", "shlex", ] @@ -170,8 +507,8 @@ dependencies = [ "serde", "serde_json", "serde_with", - "smol_str", - "thiserror", + "smol_str 0.3.6", + "thiserror 2.0.18", ] [[package]] @@ -196,9 +533,9 @@ dependencies = [ "serde", "serde_json", "serde_with", - "smol_str", + "smol_str 0.3.6", "stacker", - "thiserror", + "thiserror 2.0.18", "unicode-security", ] @@ -214,7 +551,7 @@ dependencies = [ "miette", "pretty", "regex", - "smol_str", + "smol_str 0.3.6", ] [[package]] @@ -242,102 +579,259 @@ dependencies = [ ] [[package]] -name = "core-foundation-sys" -version = "0.8.7" +name = "clipboard-win" +version = "5.4.1" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "773648b94d0e5d620f64f280777445740e61fe701025087ec8b57f45c791888b" +checksum = "bde03770d3df201d4fb868f2c9c59e66a3e4e2bd06692a0fe701e7103c7e84d4" +dependencies = [ + "error-code", +] [[package]] -name = "cpufeatures" -version = "0.2.17" +name = "clipboard_macos" +version = "0.1.1" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "59ed5838eebb26a2bb2e58f6d5b5316989ae9d08bab10e0e6d103e656d1b0280" +checksum = "9b7f4aaa047ba3c3630b080bb9860894732ff23e2aee290a418909aa6d5df38f" dependencies = [ - "libc", + "objc2 0.5.2", + "objc2-app-kit 0.2.2", + "objc2-foundation 0.2.2", ] [[package]] -name = "cranelift-assembler-x64" -version = "0.132.0" +name = "clipboard_wayland" +version = "0.2.2" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "8c80cf55a351448317210f26c434be761bcb25e7b36116ec92f89540b73e2833" +checksum = "003f886bc4e2987729d10c1db3424e7f80809f3fc22dbc16c685738887cb37b8" dependencies = [ - "cranelift-assembler-x64-meta", + "smithay-clipboard", ] [[package]] -name = "cranelift-assembler-x64-meta" -version = "0.132.0" +name = "clipboard_x11" +version = "0.4.3" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "07937ca8617b340162fe3a4716be885b5847e9b56d6c7a89abbe4d42340fdc91" +checksum = "bd63e33452ffdafd39924c4f05a5dd1e94db646c779c6bd59148a3d95fff5ad4" dependencies = [ - "cranelift-srcgen", + "thiserror 2.0.18", + "x11rb", ] [[package]] -name = "cranelift-bforest" -version = "0.132.0" +name = "codespan-reporting" +version = "0.12.0" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "88217b08180882436d54c0133274885c590698ae854e352bede1cda041230800" +checksum = "fe6d2e5af09e8c8ad56c969f2157a3d4238cebc7c55f0a517728c38f7b200f81" dependencies = [ - "cranelift-entity", - "wasmtime-internal-core", + "serde", + "termcolor", + "unicode-width 0.2.2", ] [[package]] -name = "cranelift-bitset" -version = "0.132.0" +name = "combine" +version = "4.6.7" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "d5c3cf7ba29fa56e56040848e34835d4e45988b2760ef212413409af95ffd8c1" +checksum = "ba5a308b75df32fe02788e748662718f03fde005016435c444eea572398219fd" dependencies = [ - "wasmtime-internal-core", + "bytes", + "memchr", ] [[package]] -name = "cranelift-codegen" -version = "0.132.0" +name = "concurrent-queue" +version = "2.5.0" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "ebe1aac2efd4cba2047845fce38a68519935a30e20c8a6294ba7e2f448fe722d" +checksum = "4ca0197aee26d1ae37445ee532fefce43251d24cc7c166799f4d46817f1d3973" dependencies = [ - "bumpalo", - "cranelift-assembler-x64", - "cranelift-bforest", - "cranelift-bitset", - "cranelift-codegen-meta", - "cranelift-codegen-shared", - "cranelift-control", - "cranelift-entity", - "cranelift-isle", - "gimli", - "hashbrown 0.17.1", - "libm", - "log", - "regalloc2", - "rustc-hash", - "serde", - "smallvec", - "target-lexicon", - "wasmtime-internal-core", + "crossbeam-utils", ] [[package]] -name = "cranelift-codegen-meta" -version = "0.132.0" +name = "core-foundation" +version = "0.9.4" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "0909eaf9d6f18f5bf802d50608cb4368ac340fbd03cc44f2888d1cfcc3faa64e" +checksum = "91e195e091a93c46f7102ec7818a2aa394e1e1771c3ab4825963fa03e45afb8f" dependencies = [ - "cranelift-assembler-x64-meta", - "cranelift-codegen-shared", - "cranelift-srcgen", - "heck", + "core-foundation-sys", + "libc", ] [[package]] -name = "cranelift-codegen-shared" -version = "0.132.0" +name = "core-foundation" +version = "0.10.1" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "c95a8da8be283f49cda7d0ef228c94f10d791e517b27b0c7e282dadd2e79ce45" - +checksum = "b2a6cd9ae233e7f62ba4e9353e81a88df7fc8a5987b8d445b4d90c879bd156f6" +dependencies = [ + "core-foundation-sys", + "libc", +] + +[[package]] +name = "core-foundation-sys" +version = "0.8.7" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "773648b94d0e5d620f64f280777445740e61fe701025087ec8b57f45c791888b" + +[[package]] +name = "core-graphics" +version = "0.23.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "c07782be35f9e1140080c6b96f0d44b739e2278479f64e02fdab4e32dfd8b081" +dependencies = [ + "bitflags 1.3.2", + "core-foundation 0.9.4", + "core-graphics-types 0.1.3", + "foreign-types", + "libc", +] + +[[package]] +name = "core-graphics-types" +version = "0.1.3" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "45390e6114f68f718cc7a830514a96f903cccd70d02a8f6d9f643ac4ba45afaf" +dependencies = [ + "bitflags 1.3.2", + "core-foundation 0.9.4", + "libc", +] + +[[package]] +name = "core-graphics-types" +version = "0.2.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "3d44a101f213f6c4cdc1853d4b78aef6db6bdfa3468798cc1d9912f4735013eb" +dependencies = [ + "bitflags 2.11.1", + "core-foundation 0.10.1", + "libc", +] + +[[package]] +name = "core_maths" +version = "0.1.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "77745e017f5edba1a9c1d854f6f3a52dac8a12dd5af5d2f54aecf61e43d80d30" +dependencies = [ + "libm", +] + +[[package]] +name = "cosmic-text" +version = "0.15.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "173852283a9a57a3cbe365d86e74dc428a09c50421477d5ad6fe9d9509e37737" +dependencies = [ + "bitflags 2.11.1", + "fontdb", + "harfrust", + "linebender_resource_handle", + "log", + "rangemap", + "rustc-hash 1.1.0", + "self_cell", + "skrifa 0.37.0", + "smol_str 0.2.2", + "swash", + "sys-locale", + "unicode-bidi", + "unicode-linebreak", + "unicode-script", + "unicode-segmentation", +] + +[[package]] +name = "cpufeatures" +version = "0.2.17" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "59ed5838eebb26a2bb2e58f6d5b5316989ae9d08bab10e0e6d103e656d1b0280" +dependencies = [ + "libc", +] + +[[package]] +name = "cranelift-assembler-x64" +version = "0.132.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "8c80cf55a351448317210f26c434be761bcb25e7b36116ec92f89540b73e2833" +dependencies = [ + "cranelift-assembler-x64-meta", +] + +[[package]] +name = "cranelift-assembler-x64-meta" +version = "0.132.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "07937ca8617b340162fe3a4716be885b5847e9b56d6c7a89abbe4d42340fdc91" +dependencies = [ + "cranelift-srcgen", +] + +[[package]] +name = "cranelift-bforest" +version = "0.132.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "88217b08180882436d54c0133274885c590698ae854e352bede1cda041230800" +dependencies = [ + "cranelift-entity", + "wasmtime-internal-core", +] + +[[package]] +name = "cranelift-bitset" +version = "0.132.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "d5c3cf7ba29fa56e56040848e34835d4e45988b2760ef212413409af95ffd8c1" +dependencies = [ + "wasmtime-internal-core", +] + +[[package]] +name = "cranelift-codegen" +version = "0.132.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "ebe1aac2efd4cba2047845fce38a68519935a30e20c8a6294ba7e2f448fe722d" +dependencies = [ + "bumpalo", + "cranelift-assembler-x64", + "cranelift-bforest", + "cranelift-bitset", + "cranelift-codegen-meta", + "cranelift-codegen-shared", + "cranelift-control", + "cranelift-entity", + "cranelift-isle", + "gimli", + "hashbrown 0.17.1", + "libm", + "log", + "regalloc2", + "rustc-hash 2.1.2", + "serde", + "smallvec", + "target-lexicon", + "wasmtime-internal-core", +] + +[[package]] +name = "cranelift-codegen-meta" +version = "0.132.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "0909eaf9d6f18f5bf802d50608cb4368ac340fbd03cc44f2888d1cfcc3faa64e" +dependencies = [ + "cranelift-assembler-x64-meta", + "cranelift-codegen-shared", + "cranelift-srcgen", + "heck", +] + +[[package]] +name = "cranelift-codegen-shared" +version = "0.132.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "c95a8da8be283f49cda7d0ef228c94f10d791e517b27b0c7e282dadd2e79ce45" + [[package]] name = "cranelift-control" version = "0.132.0" @@ -389,7 +883,7 @@ dependencies = [ "cranelift-native", "libc", "log", - "memmap2", + "memmap2 0.2.3", "region", "target-lexicon", "wasmtime-internal-jit-icache-coherence", @@ -424,6 +918,31 @@ version = "0.132.0" source = "registry+https://github.com/rust-lang/crates.io-index" checksum = "a3ceab9a53f7d362c89841fbaa8e63e44d47c40e91dc96ee6f777fca5d6b323b" +[[package]] +name = "crossbeam-utils" +version = "0.8.21" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "d0a5c400df2834b80a4c3327b3aad3a4c4cd4de0629063962b03235697506a28" + +[[package]] +name = "crunchy" +version = "0.2.4" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "460fbee9c2c2f33933d720630a6a0bac33ba7053db5344fac858d4b8952d77d5" + +[[package]] +name = "cryoglyph" +version = "0.1.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "08bc795bdbccdbd461736fb163930a009da6597b226d6f6fce33e7a8eb6ec519" +dependencies = [ + "cosmic-text", + "etagere", + "lru", + "rustc-hash 2.1.2", + "wgpu", +] + [[package]] name = "crypto-common" version = "0.1.7" @@ -434,6 +953,21 @@ dependencies = [ "typenum", ] +[[package]] +name = "ctor" +version = "0.10.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "83cf0d42651b16c6dfe68685716d18480d18a9c39c62d76e8cf3eb6ed5d8bcbf" +dependencies = [ + "dtor", +] + +[[package]] +name = "cursor-icon" +version = "1.2.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "f27ae1dd37df86211c42e150270f82743308803d90a6f6e6651cd730d5e1732f" + [[package]] name = "darling" version = "0.23.0" @@ -488,6 +1022,58 @@ dependencies = [ "crypto-common", ] +[[package]] +name = "dispatch" +version = "0.2.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "bd0c93bb4b0c6d9b77f4435b0ae98c24d17f1c45b2ff844c6151a07256ca923b" + +[[package]] +name = "dispatch2" +version = "0.3.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "1e0e367e4e7da84520dedcac1901e4da967309406d1e51017ae1abfb97adbd38" +dependencies = [ + "bitflags 2.11.1", + "objc2 0.6.4", +] + +[[package]] +name = "dlib" +version = "0.5.3" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "ab8ecd87370524b461f8557c119c405552c396ed91fc0a8eec68679eab26f94a" +dependencies = [ + "libloading", +] + +[[package]] +name = "document-features" +version = "0.2.12" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "d4b8a88685455ed29a21542a33abd9cb6510b6b129abadabdcef0f4c55bc8f61" +dependencies = [ + "litrs", +] + +[[package]] +name = "downcast-rs" +version = "1.2.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "75b325c5dbd37f80359721ad39aca5a29fb04c89279657cffdda8736d0c0b9d2" + +[[package]] +name = "dpi" +version = "0.1.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "d8b14ccef22fc6f5a8f4d7d768562a182c04ce9a3b3157b91390b52ddfdf1a76" + +[[package]] +name = "dtor" +version = "0.8.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "edf234dd1594d6dd434a8fb8cada51ddbbc593e40e4a01556a0b31c62da2775b" + [[package]] name = "dyn-clone" version = "1.0.20" @@ -521,6 +1107,12 @@ dependencies = [ "log", ] +[[package]] +name = "endi" +version = "1.1.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "66b7e2430c6dff6a955451e2cfc438f09cea1965a9d6f87f7e3b90decc014099" + [[package]] name = "enum-ordinalize" version = "4.3.2" @@ -542,963 +1134,2909 @@ dependencies = [ ] [[package]] -name = "equivalent" -version = "1.0.2" +name = "enumflags2" +version = "0.7.12" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "877a4ace8713b0bcf2a4e7eec82529c029f1d0619886d18145fea96c3ffe5c0f" +checksum = "1027f7680c853e056ebcec683615fb6fbbc07dbaa13b4d5d9442b146ded4ecef" +dependencies = [ + "enumflags2_derive", + "serde", +] [[package]] -name = "find-msvc-tools" -version = "0.1.9" +name = "enumflags2_derive" +version = "0.7.12" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "5baebc0774151f905a1a2cc41989300b1e6fbb29aff0ceffa1064fdd3088d582" +checksum = "67c78a4d8fdf9953a5c9d458f9efe940fd97a0cab0941c075a813ac594733827" +dependencies = [ + "proc-macro2", + "quote", + "syn", +] [[package]] -name = "fixedbitset" -version = "0.5.7" +name = "equivalent" +version = "1.0.2" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "1d674e81391d1e1ab681a28d99df07927c6d4aa5b027d7da16ba32d1d21ecd99" +checksum = "877a4ace8713b0bcf2a4e7eec82529c029f1d0619886d18145fea96c3ffe5c0f" [[package]] -name = "fnv" -version = "1.0.7" +name = "errno" +version = "0.3.14" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "3f9eec918d3f24069decb9af1554cad7c880e2da24a9afd88aca000531ab82c1" +checksum = "39cab71617ae0d63f51a36d69f866391735b51691dbda63cf6f96d042b63efeb" +dependencies = [ + "libc", + "windows-sys 0.61.2", +] [[package]] -name = "foldhash" -version = "0.2.0" +name = "error-code" +version = "3.3.2" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "77ce24cb58228fbb8aa041425bb1050850ac19177686ea6e0f41a70416f56fdb" +checksum = "dea2df4cf52843e0452895c455a1a2cfbb842a1e7329671acf418fdc53ed4c59" [[package]] -name = "futures-core" -version = "0.3.32" +name = "etagere" +version = "0.2.15" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "7e3450815272ef58cec6d564423f6e755e25379b217b0bc688e295ba24df6b1d" +checksum = "fc89bf99e5dc15954a60f707c1e09d7540e5cd9af85fa75caa0b510bc08c5342" +dependencies = [ + "euclid", + "svg_fmt", +] [[package]] -name = "futures-task" -version = "0.3.32" +name = "euclid" +version = "0.22.14" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "037711b3d59c33004d3856fbdc83b99d4ff37a24768fa1be9ce3538a1cde4393" +checksum = "f1a05365e3b1c6d1650318537c7460c6923f1abdd272ad6842baa2b509957a06" +dependencies = [ + "num-traits", +] [[package]] -name = "futures-util" -version = "0.3.32" +name = "event-listener" +version = "5.4.1" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "389ca41296e6190b48053de0321d02a77f32f8a5d2461dd38762c0593805c6d6" +checksum = "e13b66accf52311f30a0db42147dadea9850cb48cd070028831ae5f5d4b856ab" dependencies = [ - "futures-core", - "futures-task", + "concurrent-queue", + "parking", "pin-project-lite", - "slab", ] [[package]] -name = "generic-array" -version = "0.14.7" +name = "event-listener-strategy" +version = "0.5.4" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "85649ca51fd72272d7821adaf274ad91c288277713d9c18820d8499a7ff69e9a" +checksum = "8be9f3dfaaffdae2972880079a491a1a8bb7cbed0b8dd7a347f668b4150a3b93" dependencies = [ - "typenum", - "version_check", + "event-listener", + "pin-project-lite", ] [[package]] -name = "gimli" -version = "0.33.0" +name = "fastrand" +version = "2.4.1" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "0bf7f043f89559805f8c7cacc432749b2fa0d0a0a9ee46ce47164ed5ba7f126c" -dependencies = [ - "fnv", - "hashbrown 0.16.1", - "indexmap 2.14.0", - "stable_deref_trait", -] +checksum = "9f1f227452a390804cdb637b74a86990f2a7d7ba4b7d5693aac9b4dd6defd8d6" [[package]] -name = "hashbrown" -version = "0.12.3" +name = "find-msvc-tools" +version = "0.1.9" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "8a9ee70c43aaf417c914396645a0fa852624801b24ebb7ae78fe8272889ac888" +checksum = "5baebc0774151f905a1a2cc41989300b1e6fbb29aff0ceffa1064fdd3088d582" [[package]] -name = "hashbrown" -version = "0.16.1" +name = "fixedbitset" +version = "0.5.7" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "841d1cc9bed7f9236f321df977030373f4a4163ae1a7dbfe1a51a2c1a51d9100" +checksum = "1d674e81391d1e1ab681a28d99df07927c6d4aa5b027d7da16ba32d1d21ecd99" [[package]] -name = "hashbrown" -version = "0.17.1" +name = "fnv" +version = "1.0.7" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "ed5909b6e89a2db4456e54cd5f673791d7eca6732202bbf2a9cc504fe2f9b84a" -dependencies = [ - "foldhash", -] +checksum = "3f9eec918d3f24069decb9af1554cad7c880e2da24a9afd88aca000531ab82c1" [[package]] -name = "heck" -version = "0.5.0" +name = "foldhash" +version = "0.1.5" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "2304e00983f87ffb38b55b444b5e3b60a884b5d30c0fca7d82fe33449bbe55ea" +checksum = "d9c4f5dac5e15c24eb999c26181a6ca40b39fe946cbe4c263c7209467bc83af2" [[package]] -name = "hex" -version = "0.4.3" +name = "foldhash" +version = "0.2.0" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "7f24254aa9a54b5c858eaee2f5bccdb46aaf0e486a595ed5fd8f86ba55232a70" +checksum = "77ce24cb58228fbb8aa041425bb1050850ac19177686ea6e0f41a70416f56fdb" [[package]] -name = "iana-time-zone" -version = "0.1.65" +name = "font-types" +version = "0.10.1" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "e31bc9ad994ba00e440a8aa5c9ef0ec67d5cb5e5cb0cc7f8b744a35b389cc470" +checksum = "39a654f404bbcbd48ea58c617c2993ee91d1cb63727a37bf2323a4edeed1b8c5" dependencies = [ - "android_system_properties", - "core-foundation-sys", - "iana-time-zone-haiku", - "js-sys", - "log", - "wasm-bindgen", - "windows-core", + "bytemuck", ] [[package]] -name = "iana-time-zone-haiku" -version = "0.1.2" +name = "font-types" +version = "0.11.3" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "f31827a206f56af32e590ba56d5d2d085f558508192593743f16b2306495269f" +checksum = "5b38ad915f6dadd993ced50848a8291a543bd41ca62bc10740d5e64e2ab4cfd7" dependencies = [ - "cc", + "bytemuck", ] [[package]] -name = "ident_case" -version = "1.0.1" +name = "fontconfig-parser" +version = "0.5.8" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "b9e0384b61958566e926dc50660321d12159025e767c18e043daf26b70104c39" +checksum = "bbc773e24e02d4ddd8395fd30dc147524273a83e54e0f312d986ea30de5f5646" +dependencies = [ + "roxmltree", +] [[package]] -name = "indexmap" -version = "1.9.3" +name = "fontdb" +version = "0.23.0" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "bd070e393353796e801d209ad339e89596eb4c8d430d18ede6a1cced8fafbd99" +checksum = "457e789b3d1202543297a350643cf459f836cade38934e7a4cf6a39e7cde2905" dependencies = [ - "autocfg", - "hashbrown 0.12.3", - "serde", + "fontconfig-parser", + "log", + "memmap2 0.9.10", + "slotmap", + "tinyvec", + "ttf-parser", ] [[package]] -name = "indexmap" -version = "2.14.0" +name = "foreign-types" +version = "0.5.0" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "d466e9454f08e4a911e14806c24e16fba1b4c121d1ea474396f396069cf949d9" +checksum = "d737d9aa519fb7b749cbc3b962edcf310a8dd1f4b67c91c4f83975dbdd17d965" dependencies = [ - "equivalent", - "hashbrown 0.17.1", - "serde", - "serde_core", + "foreign-types-macros", + "foreign-types-shared", ] [[package]] -name = "itertools" -version = "0.14.0" +name = "foreign-types-macros" +version = "0.2.3" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "2b192c782037fadd9cfa75548310488aabdbf3d2da73885b31bd0abd03351285" +checksum = "1a5c6c585bc94aaf2c7b51dd4c2ba22680844aba4c687be581871a6f518c5742" dependencies = [ - "either", + "proc-macro2", + "quote", + "syn", ] [[package]] -name = "itoa" -version = "1.0.18" +name = "foreign-types-shared" +version = "0.3.1" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "8f42a60cbdf9a97f5d2305f08a87dc4e09308d1276d28c869c684d7777685682" +checksum = "aa9a19cbb55df58761df49b23516a86d432839add4af60fc256da840f66ed35b" [[package]] -name = "js-sys" -version = "0.3.99" +name = "futures" +version = "0.3.32" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "142bc4740e452c1e57ade0cbc129f139c9093e354346f0872ef985f4f5cf5f11" +checksum = "8b147ee9d1f6d097cef9ce628cd2ee62288d963e16fb287bd9286455b241382d" dependencies = [ - "cfg-if", + "futures-channel", + "futures-core", + "futures-executor", + "futures-io", + "futures-sink", + "futures-task", "futures-util", - "once_cell", - "wasm-bindgen", ] [[package]] -name = "keccak" -version = "0.1.6" +name = "futures-channel" +version = "0.3.32" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "cb26cec98cce3a3d96cbb7bced3c4b16e3d13f27ec56dbd62cbc8f39cfb9d653" +checksum = "07bbe89c50d7a535e539b8c17bc0b49bdb77747034daa8087407d655f3f7cc1d" dependencies = [ - "cpufeatures", + "futures-core", + "futures-sink", ] [[package]] -name = "klcompile" -version = "0.1.0" +name = "futures-core" +version = "0.3.32" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "7e3450815272ef58cec6d564423f6e755e25379b217b0bc688e295ba24df6b1d" + +[[package]] +name = "futures-executor" +version = "0.3.32" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "baf29c38818342a3b26b5b923639e7b1f4a61fc5e76102d4b1981c6dc7a7579d" dependencies = [ - "shen-rust", + "futures-core", + "futures-task", + "futures-util", ] [[package]] -name = "lalrpop" -version = "0.22.2" +name = "futures-io" +version = "0.3.32" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "ba4ebbd48ce411c1d10fb35185f5a51a7bfa3d8b24b4e330d30c9e3a34129501" +checksum = "cecba35d7ad927e23624b22ad55235f2239cfa44fd10428eecbeba6d6a717718" + +[[package]] +name = "futures-lite" +version = "2.6.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "f78e10609fe0e0b3f4157ffab1876319b5b0db102a2c60dc4626306dc46b44ad" dependencies = [ - "ascii-canvas", - "bit-set", - "ena", - "itertools", - "lalrpop-util", - "petgraph", - "pico-args", - "regex", - "regex-syntax", - "sha3", - "string_cache", - "term", - "unicode-xid", - "walkdir", + "fastrand", + "futures-core", + "futures-io", + "parking", + "pin-project-lite", ] [[package]] -name = "lalrpop-util" -version = "0.22.2" +name = "futures-macro" +version = "0.3.32" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "b5baa5e9ff84f1aefd264e6869907646538a52147a755d494517a8007fb48733" +checksum = "e835b70203e41293343137df5c0664546da5745f82ec9b84d40be8336958447b" dependencies = [ - "regex-automata", - "rustversion", + "proc-macro2", + "quote", + "syn", ] [[package]] -name = "libc" -version = "0.2.186" +name = "futures-sink" +version = "0.3.32" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "68ab91017fe16c622486840e4c83c9a37afeff978bd239b5293d61ece587de66" +checksum = "c39754e157331b013978ec91992bde1ac089843443c49cbc7f46150b0fad0893" [[package]] -name = "libm" -version = "0.2.16" +name = "futures-task" +version = "0.3.32" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "b6d2cec3eae94f9f509c767b45932f1ada8350c4bdb85af2fcab4a3c14807981" +checksum = "037711b3d59c33004d3856fbdc83b99d4ff37a24768fa1be9ce3538a1cde4393" [[package]] -name = "linked-hash-map" -version = "0.5.6" +name = "futures-util" +version = "0.3.32" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "0717cef1bc8b636c6e1c1bbdefc09e6322da8a9321966e8928ef80d20f7f770f" +checksum = "389ca41296e6190b48053de0321d02a77f32f8a5d2461dd38762c0593805c6d6" dependencies = [ - "serde", + "futures-channel", + "futures-core", + "futures-io", + "futures-macro", + "futures-sink", + "futures-task", + "memchr", + "pin-project-lite", + "slab", ] [[package]] -name = "linked_hash_set" -version = "0.1.6" +name = "generic-array" +version = "0.14.7" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "984fb35d06508d1e69fc91050cceba9c0b748f983e6739fa2c7a9237154c52c8" +checksum = "85649ca51fd72272d7821adaf274ad91c288277713d9c18820d8499a7ff69e9a" dependencies = [ - "linked-hash-map", + "typenum", + "version_check", ] [[package]] -name = "lock_api" -version = "0.4.14" +name = "gethostname" +version = "1.1.0" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "224399e74b87b5f3557511d98dff8b14089b3dadafcab6bb93eab67d3aace965" +checksum = "1bd49230192a3797a9a4d6abe9b3eed6f7fa4c8a8a4947977c6f80025f92cbd8" dependencies = [ - "scopeguard", + "rustix 1.1.4", + "windows-link", ] [[package]] -name = "log" -version = "0.4.30" +name = "getrandom" +version = "0.3.4" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "616ec5685824bcc94416c6d4a7a446eea774a31efd7062c8480ba6fd06d7a6e5" +checksum = "899def5c37c4fd7b2664648c28120ecec138e4d395b459e5ca34f9cce2dd77fd" +dependencies = [ + "cfg-if", + "libc", + "r-efi 5.3.0", + "wasip2", +] [[package]] -name = "logos" -version = "0.16.1" +name = "getrandom" +version = "0.4.3" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "eb2c55a318a87600ea870ff8c2012148b44bf18b74fad48d0f835c38c7d07c5f" +checksum = "300e883d756b2e4ec94e02791f39b04b522276138852cfc41d9fb7e904106099" dependencies = [ - "logos-derive", + "cfg-if", + "libc", + "r-efi 6.0.0", ] [[package]] -name = "logos-codegen" -version = "0.16.1" +name = "gimli" +version = "0.33.0" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "58b3ffaa284e1350d017a57d04ada118c4583cf260c8fb01e0fe28a2e9cf8970" +checksum = "0bf7f043f89559805f8c7cacc432749b2fa0d0a0a9ee46ce47164ed5ba7f126c" dependencies = [ "fnv", - "proc-macro2", - "quote", - "regex-automata", - "regex-syntax", - "syn", + "hashbrown 0.16.1", + "indexmap 2.14.0", + "stable_deref_trait", ] [[package]] -name = "logos-derive" -version = "0.16.1" +name = "gl_generator" +version = "0.14.0" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "52d3a9855747c17eaf4383823f135220716ab49bea5fbea7dd42cc9a92f8aa31" +checksum = "1a95dfc23a2b4a9a2f5ab41d194f8bfda3cabec42af4e39f08c339eb2a0c124d" dependencies = [ - "logos-codegen", + "khronos_api", + "log", + "xml-rs", ] [[package]] -name = "mach2" -version = "0.4.3" +name = "glam" +version = "0.25.0" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "d640282b302c0bb0a2a8e0233ead9035e3bed871f0b7e81fe4a1ec829765db44" +checksum = "151665d9be52f9bb40fc7966565d39666f2d1e69233571b71b87791c7e0528b3" + +[[package]] +name = "glow" +version = "0.16.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "c5e5ea60d70410161c8bf5da3fdfeaa1c72ed2c15f8bbb9d19fe3a4fad085f08" dependencies = [ - "libc", + "js-sys", + "slotmap", + "wasm-bindgen", + "web-sys", ] [[package]] -name = "memchr" -version = "2.8.1" +name = "glutin_wgl_sys" +version = "0.6.1" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "6b947ae49db0d222b1dbc6b113ce7248a3fc3a6ca21b696717bfc000ba4484d8" +checksum = "2c4ee00b289aba7a9e5306d57c2d05499b2e5dc427f84ac708bd2c090212cf3e" +dependencies = [ + "gl_generator", +] [[package]] -name = "memmap2" -version = "0.2.3" +name = "gpu-alloc" +version = "0.6.0" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "723e3ebdcdc5c023db1df315364573789f8857c11b631a2fdfad7c00f5c046b4" +checksum = "fbcd2dba93594b227a1f57ee09b8b9da8892c34d55aa332e034a228d0fe6a171" dependencies = [ - "libc", + "bitflags 2.11.1", + "gpu-alloc-types", ] [[package]] -name = "miette" -version = "7.6.0" +name = "gpu-alloc-types" +version = "0.3.0" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "5f98efec8807c63c752b5bd61f862c165c115b0a35685bdcfd9238c7aeb592b7" +checksum = "98ff03b468aa837d70984d55f5d3f846f6ec31fe34bbb97c4f85219caeee1ca4" dependencies = [ - "cfg-if", - "miette-derive", - "serde", - "unicode-width 0.1.14", + "bitflags 2.11.1", ] [[package]] -name = "miette-derive" -version = "7.6.0" +name = "gpu-allocator" +version = "0.27.0" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "db5b29714e950dbb20d5e6f74f9dcec4edbcc1067bb7f8ed198c097b8c1a818b" +checksum = "c151a2a5ef800297b4e79efa4f4bec035c5f51d5ae587287c9b952bdf734cacd" dependencies = [ - "proc-macro2", - "quote", - "syn", + "log", + "presser", + "thiserror 1.0.69", + "windows 0.58.0", ] [[package]] -name = "new_debug_unreachable" -version = "1.0.6" +name = "gpu-descriptor" +version = "0.3.2" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "650eef8c711430f1a879fdd01d4745a7deea475becfb90269c06775983bbf086" +checksum = "b89c83349105e3732062a895becfc71a8f921bb71ecbbdd8ff99263e3b53a0ca" +dependencies = [ + "bitflags 2.11.1", + "gpu-descriptor-types", + "hashbrown 0.15.5", +] [[package]] -name = "nonempty" -version = "0.12.0" +name = "gpu-descriptor-types" +version = "0.2.0" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "9737e026353e5cd0736f98eddae28665118eb6f6600902a7f50db585621fecb6" +checksum = "fdf242682df893b86f33a73828fb09ca4b2d3bb6cc95249707fc684d27484b91" dependencies = [ - "serde", + "bitflags 2.11.1", ] [[package]] -name = "num-conv" -version = "0.2.2" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "521739c6d2bac4aa25192232afe6841231376b2b26d4d9fae5ecf8ca5772e441" - -[[package]] -name = "num-traits" -version = "0.2.19" +name = "guillotiere" +version = "0.6.2" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "071dfc062690e90b734c0b2273ce72ad0ffa95f0c74596bc250dcfd960262841" +checksum = "b62d5865c036cb1393e23c50693df631d3f5d7bcca4c04fe4cc0fd592e74a782" dependencies = [ - "autocfg", + "euclid", + "svg_fmt", ] [[package]] -name = "object" -version = "0.37.3" +name = "half" +version = "2.7.1" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "ff76201f031d8863c38aa7f905eca4f53abbfa15f609db4277d44cd8938f33fe" +checksum = "6ea2d84b969582b4b1864a92dc5d27cd2b77b622a8d79306834f1be5ba20d84b" dependencies = [ - "memchr", + "cfg-if", + "crunchy", + "num-traits", + "zerocopy", ] [[package]] -name = "once_cell" -version = "1.21.4" +name = "harfrust" +version = "0.3.2" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "9f7c3e4beb33f85d45ae3e3a1792185706c8e16d043238c593331cc7cd313b50" +checksum = "92c020db12c71d8a12a3fe7607873cade3a01a6287e29d540c8723276221b9d8" +dependencies = [ + "bitflags 2.11.1", + "bytemuck", + "core_maths", + "read-fonts 0.35.0", + "smallvec", +] [[package]] -name = "parking_lot" -version = "0.12.5" +name = "hashbrown" +version = "0.12.3" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "93857453250e3077bd71ff98b6a65ea6621a19bb0f559a85248955ac12c45a1a" -dependencies = [ - "lock_api", - "parking_lot_core", -] +checksum = "8a9ee70c43aaf417c914396645a0fa852624801b24ebb7ae78fe8272889ac888" [[package]] -name = "parking_lot_core" -version = "0.9.12" +name = "hashbrown" +version = "0.15.5" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "2621685985a2ebf1c516881c026032ac7deafcda1a2c9b7850dc81e3dfcb64c1" +checksum = "9229cfe53dfd69f0609a49f65461bd93001ea1ef889cd5529dd176593f5338a1" dependencies = [ - "cfg-if", - "libc", - "redox_syscall", - "smallvec", - "windows-link", + "foldhash 0.1.5", ] [[package]] -name = "petgraph" -version = "0.7.1" +name = "hashbrown" +version = "0.16.1" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "3672b37090dbd86368a4145bc067582552b29c27377cad4e0a306c97f9bd7772" +checksum = "841d1cc9bed7f9236f321df977030373f4a4163ae1a7dbfe1a51a2c1a51d9100" dependencies = [ - "fixedbitset", - "indexmap 2.14.0", + "foldhash 0.2.0", ] [[package]] -name = "phf_shared" -version = "0.11.3" +name = "hashbrown" +version = "0.17.1" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "67eabc2ef2a60eb7faa00097bd1ffdb5bd28e62bf39990626a582201b7a754e5" +checksum = "ed5909b6e89a2db4456e54cd5f673791d7eca6732202bbf2a9cc504fe2f9b84a" dependencies = [ - "siphasher", + "foldhash 0.2.0", ] [[package]] -name = "pico-args" +name = "heck" version = "0.5.0" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "5be167a7af36ee22fe3115051bc51f6e6c7054c9348e28deb4f49bd6f705a315" +checksum = "2304e00983f87ffb38b55b444b5e3b60a884b5d30c0fca7d82fe33449bbe55ea" [[package]] -name = "pin-project-lite" -version = "0.2.17" +name = "hermit-abi" +version = "0.5.2" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "a89322df9ebe1c1578d689c92318e070967d1042b512afbe49518723f4e6d5cd" +checksum = "fc0fef456e4baa96da950455cd02c081ca953b141298e41db3fc7e36b1da849c" [[package]] -name = "powerfmt" -version = "0.2.0" +name = "hex" +version = "0.4.3" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "439ee305def115ba05938db6eb1644ff94165c5ab5e9420d1c1bcedbba909391" +checksum = "7f24254aa9a54b5c858eaee2f5bccdb46aaf0e486a595ed5fd8f86ba55232a70" [[package]] -name = "precomputed-hash" -version = "0.1.1" +name = "hexf-parse" +version = "0.2.1" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "925383efa346730478fb4838dbe9137d2a47675ad789c546d150a6e1dd4ab31c" +checksum = "dfa686283ad6dd069f105e5ab091b04c62850d3e4cf5d67debad1933f55023df" [[package]] -name = "pretty" -version = "0.12.5" +name = "iana-time-zone" +version = "0.1.65" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "0d22152487193190344590e4f30e219cf3fe140d9e7a3fdb683d82aa2c5f4156" +checksum = "e31bc9ad994ba00e440a8aa5c9ef0ec67d5cb5e5cb0cc7f8b744a35b389cc470" dependencies = [ - "arrayvec", - "typed-arena", - "unicode-width 0.2.2", + "android_system_properties", + "core-foundation-sys", + "iana-time-zone-haiku", + "js-sys", + "log", + "wasm-bindgen", + "windows-core 0.62.2", ] [[package]] -name = "proc-macro2" -version = "1.0.106" +name = "iana-time-zone-haiku" +version = "0.1.2" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "8fd00f0bb2e90d81d1044c2b32617f68fcb9fa3bb7640c23e9c748e53fb30934" +checksum = "f31827a206f56af32e590ba56d5d2d085f558508192593743f16b2306495269f" dependencies = [ - "unicode-ident", + "cc", ] [[package]] -name = "psm" -version = "0.1.31" +name = "iced" +version = "0.14.0" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "645dbe486e346d9b5de3ef16ede18c26e6c70ad97418f4874b8b1889d6e761ea" +checksum = "000e01026c93ba643f8357a3db3ada0e6555265a377f6f9291c472f6dd701fb3" dependencies = [ - "ar_archive_writer", - "cc", + "iced_core", + "iced_debug", + "iced_futures", + "iced_renderer", + "iced_runtime", + "iced_widget", + "iced_winit", + "thiserror 2.0.18", ] [[package]] -name = "quote" -version = "1.0.45" +name = "iced_core" +version = "0.14.0" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "41f2619966050689382d2b44f664f4bc593e129785a36d6ee376ddf37259b924" +checksum = "91ab1937d699403e7e69252ae743a902bcee9f4ab2052cc4c9a46fcf34729d85" dependencies = [ - "proc-macro2", + "bitflags 2.11.1", + "bytes", + "glam", + "lilt", + "log", + "num-traits", + "rustc-hash 2.1.2", + "smol_str 0.2.2", + "thiserror 2.0.18", + "web-time", ] [[package]] -name = "ratatoskr-build" -version = "0.1.0" +name = "iced_debug" +version = "0.14.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "25035ab0215a620e53f4103e36fc4e59a1fb2817e4bfc38a30ad27b4202ea0be" dependencies = [ - "klcompile", + "iced_core", + "iced_futures", + "log", ] [[package]] -name = "redox_syscall" -version = "0.5.18" +name = "iced_futures" +version = "0.14.0" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "ed2bf2547551a7053d6fdfafda3f938979645c44812fbfcda098faae3f1a362d" +checksum = "8c0c85ccad42dfbec7293c36c018af0ea0dbcc52d137a4a9a0b0f6822a3fdf0a" dependencies = [ - "bitflags 2.11.1", + "futures", + "iced_core", + "log", + "rustc-hash 2.1.2", + "wasm-bindgen-futures", + "wasmtimer", ] [[package]] -name = "ref-cast" -version = "1.0.25" +name = "iced_graphics" +version = "0.14.0" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "f354300ae66f76f1c85c5f84693f0ce81d747e2c3f21a45fef496d89c960bf7d" +checksum = "234ca1c2cec4155055f68fa5fad1b5242c496ac8238d80a259bca382fb44a102" dependencies = [ - "ref-cast-impl", + "bitflags 2.11.1", + "bytemuck", + "cosmic-text", + "half", + "iced_core", + "iced_futures", + "log", + "raw-window-handle", + "rustc-hash 2.1.2", + "thiserror 2.0.18", + "unicode-segmentation", ] [[package]] -name = "ref-cast-impl" -version = "1.0.25" +name = "iced_program" +version = "0.14.0" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "b7186006dcb21920990093f30e3dea63b7d6e977bf1256be20c3563a5db070da" +checksum = "6dfafec2947cda688d8eb00dac337ba11aa60f9ef6335aed343e189d26e4a673" dependencies = [ - "proc-macro2", - "quote", - "syn", + "iced_graphics", + "iced_runtime", ] [[package]] -name = "regalloc2" -version = "0.15.1" +name = "iced_renderer" +version = "0.14.0" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "de2c52737737f8609e94f975dee22854a2d5c125772d4b1cf292120f4d45c186" +checksum = "250cc0802408e8c077986ec56c7d07c65f423ee658a4b9fd795a1f2aae5dac05" dependencies = [ - "allocator-api2", - "bumpalo", - "hashbrown 0.17.1", + "iced_graphics", + "iced_tiny_skia", + "iced_wgpu", "log", - "rustc-hash", - "smallvec", + "thiserror 2.0.18", ] [[package]] -name = "regex" -version = "1.12.3" +name = "iced_runtime" +version = "0.14.0" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "e10754a14b9137dd7b1e3e5b0493cc9171fdd105e0ab477f51b72e7f3ac0e276" +checksum = "d1889b819ce4c06674183242e336c8d49465665441396914dc07cc86f44fa8d4" dependencies = [ - "aho-corasick", - "memchr", - "regex-automata", - "regex-syntax", + "bytes", + "iced_core", + "iced_futures", + "raw-window-handle", + "thiserror 2.0.18", ] [[package]] -name = "regex-automata" -version = "0.4.14" +name = "iced_tiny_skia" +version = "0.14.0" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "6e1dd4122fc1595e8162618945476892eefca7b88c52820e74af6262213cae8f" +checksum = "fe0acf8b75a3bc914aff5f2329fdffc1b36eeaea29dda0e4bd232f1c62e9cc3d" dependencies = [ - "aho-corasick", - "memchr", - "regex-syntax", + "bytemuck", + "cosmic-text", + "iced_debug", + "iced_graphics", + "kurbo", + "log", + "rustc-hash 2.1.2", + "softbuffer", + "tiny-skia", ] [[package]] -name = "regex-syntax" -version = "0.8.10" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "dc897dd8d9e8bd1ed8cdad82b5966c3e0ecae09fb1907d58efaa013543185d0a" - -[[package]] -name = "region" -version = "3.0.2" +name = "iced_wgpu" +version = "0.14.0" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "e6b6ebd13bc009aef9cd476c1310d49ac354d36e240cf1bd753290f3dc7199a7" +checksum = "ff144a999b0ca0f8a10257934500060240825c42e950ec0ebee9c8ae30561c13" dependencies = [ - "bitflags 1.3.2", - "libc", - "mach2", - "windows-sys 0.52.0", + "bitflags 2.11.1", + "bytemuck", + "cryoglyph", + "futures", + "glam", + "guillotiere", + "iced_debug", + "iced_graphics", + "log", + "rustc-hash 2.1.2", + "thiserror 2.0.18", + "wgpu", ] [[package]] -name = "rustc-hash" -version = "2.1.2" +name = "iced_widget" +version = "0.14.2" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "94300abf3f1ae2e2b8ffb7b58043de3d399c73fa6f4b73826402a5c457614dbe" +checksum = "b1596afa0d3109c2618e8bc12bae6c11d3064df8f95c42dfce570397dbe957ab" +dependencies = [ + "iced_renderer", + "log", + "num-traits", + "rustc-hash 2.1.2", + "thiserror 2.0.18", + "unicode-segmentation", +] [[package]] -name = "rustc-literal-escaper" -version = "0.0.7" +name = "iced_winit" +version = "0.14.0" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "8be87abb9e40db7466e0681dc8ecd9dcfd40360cb10b4c8fe24a7c4c3669b198" +checksum = "8b7dbedc47562d1de3b9707d939f678b88c382004b7ab5a18f7a7dd723162d75" +dependencies = [ + "iced_debug", + "iced_program", + "log", + "mundy", + "rustc-hash 2.1.2", + "thiserror 2.0.18", + "tracing", + "wasm-bindgen-futures", + "web-sys", + "window_clipboard", + "winit", +] [[package]] -name = "rustversion" -version = "1.0.22" +name = "ident_case" +version = "1.0.1" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "b39cdef0fa800fc44525c84ccb54a029961a8215f9619753635a9c0d2538d46d" +checksum = "b9e0384b61958566e926dc50660321d12159025e767c18e043daf26b70104c39" [[package]] -name = "same-file" -version = "1.0.6" +name = "indexmap" +version = "1.9.3" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "93fc1dc3aaa9bfed95e02e6eadabb4baf7e3078b0bd1b4d7b6b0b68378900502" +checksum = "bd070e393353796e801d209ad339e89596eb4c8d430d18ede6a1cced8fafbd99" dependencies = [ - "winapi-util", + "autocfg", + "hashbrown 0.12.3", + "serde", ] [[package]] -name = "schemars" -version = "0.9.0" +name = "indexmap" +version = "2.14.0" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "4cd191f9397d57d581cddd31014772520aa448f65ef991055d7f61582c65165f" +checksum = "d466e9454f08e4a911e14806c24e16fba1b4c121d1ea474396f396069cf949d9" dependencies = [ - "dyn-clone", - "ref-cast", + "equivalent", + "hashbrown 0.17.1", "serde", - "serde_json", + "serde_core", ] [[package]] -name = "schemars" -version = "1.2.1" +name = "itertools" +version = "0.14.0" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "a2b42f36aa1cd011945615b92222f6bf73c599a102a300334cd7f8dbeec726cc" +checksum = "2b192c782037fadd9cfa75548310488aabdbf3d2da73885b31bd0abd03351285" dependencies = [ - "dyn-clone", - "ref-cast", - "serde", - "serde_json", + "either", ] [[package]] -name = "scopeguard" -version = "1.2.0" +name = "itoa" +version = "1.0.18" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "94143f37725109f92c262ed2cf5e59bce7498c01bcc1502d7b9afe439a4e9f49" +checksum = "8f42a60cbdf9a97f5d2305f08a87dc4e09308d1276d28c869c684d7777685682" [[package]] -name = "semver" -version = "1.0.28" +name = "jni" +version = "0.22.4" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "8a7852d02fc848982e0c167ef163aaff9cd91dc640ba85e263cb1ce46fae51cd" +checksum = "5efd9a482cf3a427f00d6b35f14332adc7902ce91efb778580e180ff90fa3498" +dependencies = [ + "cfg-if", + "combine", + "jni-macros", + "jni-sys 0.4.1", + "log", + "simd_cesu8", + "thiserror 2.0.18", + "walkdir", + "windows-link", +] [[package]] -name = "serde" -version = "1.0.228" +name = "jni-macros" +version = "0.22.4" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "9a8e94ea7f378bd32cbbd37198a4a91436180c5bb472411e48b5ec2e2124ae9e" +checksum = "a00109accc170f0bdb141fed3e393c565b6f5e072365c3bd58f5b062591560a3" dependencies = [ - "serde_core", - "serde_derive", + "proc-macro2", + "quote", + "rustc_version", + "simd_cesu8", + "syn", ] [[package]] -name = "serde_core" -version = "1.0.228" +name = "jni-sys" +version = "0.3.1" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "41d385c7d4ca58e59fc732af25c3983b67ac852c1a25000afe1175de458b67ad" +checksum = "41a652e1f9b6e0275df1f15b32661cf0d4b78d4d87ddec5e0c3c20f097433258" dependencies = [ - "serde_derive", + "jni-sys 0.4.1", ] [[package]] -name = "serde_derive" -version = "1.0.228" +name = "jni-sys" +version = "0.4.1" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "d540f220d3187173da220f885ab66608367b6574e925011a9353e4badda91d79" +checksum = "c6377a88cb3910bee9b0fa88d4f42e1d2da8e79915598f65fb0c7ee14c878af2" +dependencies = [ + "jni-sys-macros", +] + +[[package]] +name = "jni-sys-macros" +version = "0.4.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "38c0b942f458fe50cdac086d2f946512305e5631e720728f2a61aabcd47a6264" dependencies = [ - "proc-macro2", "quote", "syn", ] [[package]] -name = "serde_json" -version = "1.0.150" +name = "jobserver" +version = "0.1.34" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "e8014e44b4736ed0538adeecded0fce2a272f22dc9578a7eb6b2d9993c74cfb9" +checksum = "9afb3de4395d6b3e67a780b6de64b51c978ecf11cb9a462c66be7d4ca9039d33" dependencies = [ - "indexmap 2.14.0", - "itoa", - "memchr", - "serde", - "serde_core", - "zmij", + "getrandom 0.3.4", + "libc", ] [[package]] -name = "serde_with" -version = "3.20.0" +name = "js-sys" +version = "0.3.99" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "e72c1c2cb7b223fafb600a619537a871c2818583d619401b785e7c0b746ccde2" +checksum = "142bc4740e452c1e57ade0cbc129f139c9093e354346f0872ef985f4f5cf5f11" dependencies = [ - "base64", - "bs58", - "chrono", - "hex", - "indexmap 1.9.3", - "indexmap 2.14.0", - "schemars 0.9.0", - "schemars 1.2.1", - "serde_core", - "serde_json", - "serde_with_macros", - "time", + "cfg-if", + "futures-util", + "once_cell", + "wasm-bindgen", ] [[package]] -name = "serde_with_macros" -version = "3.20.0" +name = "keccak" +version = "0.1.6" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "b90c488738ecb4fb0262f41f43bc40efc5868d9fb744319ddf5f5317f417bfac" +checksum = "cb26cec98cce3a3d96cbb7bced3c4b16e3d13f27ec56dbd62cbc8f39cfb9d653" dependencies = [ - "darling", - "proc-macro2", - "quote", - "syn", + "cpufeatures", ] [[package]] -name = "sha3" -version = "0.10.9" +name = "khronos-egl" +version = "6.0.0" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "77fd7028345d415a4034cf8777cd4f8ab1851274233b45f84e3d955502d93874" +checksum = "6aae1df220ece3c0ada96b8153459b67eebe9ae9212258bb0134ae60416fdf76" dependencies = [ - "digest", - "keccak", + "libc", + "libloading", + "pkg-config", ] [[package]] -name = "shen-cedar-authz" +name = "khronos_api" +version = "3.1.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "e2db585e1d738fc771bf08a151420d3ed193d9d895a36df7f6f8a9456b911ddc" + +[[package]] +name = "klcompile" version = "0.1.0" dependencies = [ - "cedar-policy", "shen-rust", ] [[package]] -name = "shen-rust" -version = "0.1.0" +name = "kurbo" +version = "0.10.4" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "1618d4ebd923e97d67e7cd363d80aef35fe961005cbbbb3d2dad8bdd1bc63440" dependencies = [ - "cedar-policy", - "cranelift-codegen", - "cranelift-frontend", - "cranelift-jit", - "cranelift-module", - "cranelift-native", + "arrayvec 0.7.7", "smallvec", ] [[package]] -name = "shen-rust-bin" -version = "0.1.0" +name = "lalrpop" +version = "0.22.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "ba4ebbd48ce411c1d10fb35185f5a51a7bfa3d8b24b4e330d30c9e3a34129501" dependencies = [ - "klcompile", - "shen-rust", + "ascii-canvas", + "bit-set", + "ena", + "itertools", + "lalrpop-util", + "petgraph", + "pico-args", + "regex", + "regex-syntax", + "sha3", + "string_cache", + "term", + "unicode-xid", + "walkdir", ] [[package]] -name = "shenffi" -version = "0.1.0" +name = "lalrpop-util" +version = "0.22.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "b5baa5e9ff84f1aefd264e6869907646538a52147a755d494517a8007fb48733" dependencies = [ - "shen-rust", + "regex-automata", + "rustversion", ] [[package]] -name = "shengen-rust" -version = "0.1.0" - -[[package]] -name = "shlex" -version = "1.3.0" +name = "libc" +version = "0.2.186" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "0fda2ff0d084019ba4d7c6f371c95d8fd75ce3524c3cb8fb653a3023f6323e64" +checksum = "68ab91017fe16c622486840e4c83c9a37afeff978bd239b5293d61ece587de66" [[package]] -name = "siphasher" -version = "1.0.3" +name = "libloading" +version = "0.8.9" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "8ee5873ec9cce0195efcb7a4e9507a04cd49aec9c83d0389df45b1ef7ba2e649" +checksum = "d7c4b02199fee7c5d21a5ae7d8cfa79a6ef5bb2fc834d6e9058e89c825efdc55" +dependencies = [ + "cfg-if", + "windows-link", +] [[package]] -name = "slab" -version = "0.4.12" +name = "libm" +version = "0.2.16" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "0c790de23124f9ab44544d7ac05d60440adc586479ce501c1d6d7da3cd8c9cf5" +checksum = "b6d2cec3eae94f9f509c767b45932f1ada8350c4bdb85af2fcab4a3c14807981" [[package]] -name = "smallvec" -version = "1.15.1" +name = "libredox" +version = "0.1.17" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "67b1b7a3b5fe4f1376887184045fcf45c69e92af734b7aaddc05fb777b6fbd03" +checksum = "f02ab6bace2054fb888a3c16f990117b579d14a3088e472d63c6011fa185c9d3" +dependencies = [ + "bitflags 2.11.1", + "libc", + "plain", + "redox_syscall 0.8.1", +] [[package]] -name = "smol_str" -version = "0.3.6" +name = "lilt" +version = "0.8.1" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "4aaa7368fcf4852a4c2dd92df0cace6a71f2091ca0a23391ce7f3a31833f1523" +checksum = "f67562e5eff6b20553fa9be1c503356768420994e28f67e3eafe6f41910e57ad" dependencies = [ - "borsh", - "serde_core", + "web-time", ] [[package]] -name = "stable_deref_trait" -version = "1.2.1" +name = "linebender_resource_handle" +version = "0.1.1" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "6ce2be8dc25455e1f91df71bfa12ad37d7af1092ae736f3a6cd0e37bc7810596" +checksum = "d4a5ff6bcca6c4867b1c4fd4ef63e4db7436ef363e0ad7531d1558856bae64f4" [[package]] -name = "stacker" -version = "0.1.24" +name = "linked-hash-map" +version = "0.5.6" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "640c8cdd92b6b12f5bcb1803ca3bbf5ab96e5e6b6b96b9ab77dabe9e880b3190" +checksum = "0717cef1bc8b636c6e1c1bbdefc09e6322da8a9321966e8928ef80d20f7f770f" dependencies = [ - "cc", - "cfg-if", - "libc", - "psm", - "windows-sys 0.61.2", + "serde", ] [[package]] -name = "string_cache" -version = "0.8.9" +name = "linked_hash_set" +version = "0.1.6" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "bf776ba3fa74f83bf4b63c3dcbbf82173db2632ed8452cb2d891d33f459de70f" +checksum = "984fb35d06508d1e69fc91050cceba9c0b748f983e6739fa2c7a9237154c52c8" dependencies = [ - "new_debug_unreachable", - "parking_lot", - "phf_shared", - "precomputed-hash", + "linked-hash-map", ] [[package]] -name = "strsim" -version = "0.11.1" +name = "linux-raw-sys" +version = "0.4.15" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "7da8b5736845d9f2fcb837ea5d9e2628564b3b043a70948a3f0b778838c5fb4f" +checksum = "d26c52dbd32dccf2d10cac7725f8eae5296885fb5703b261f7d0a0739ec807ab" [[package]] -name = "syn" -version = "2.0.117" +name = "linux-raw-sys" +version = "0.12.1" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "e665b8803e7b1d2a727f4023456bbbbe74da67099c585258af0ad9c5013b9b99" -dependencies = [ - "proc-macro2", - "quote", - "unicode-ident", -] +checksum = "32a66949e030da00e8c7d4434b251670a91556f4144941d37452769c25d58a53" [[package]] -name = "target-lexicon" -version = "0.13.5" +name = "litrs" +version = "1.0.0" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "adb6935a6f5c20170eeceb1a3835a49e12e19d792f6dd344ccc76a985ca5a6ca" +checksum = "11d3d7f243d5c5a8b9bb5d6dd2b1602c0cb0b9db1621bafc7ed66e35ff9fe092" [[package]] -name = "term" -version = "1.2.1" +name = "lock_api" +version = "0.4.14" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "d8c27177b12a6399ffc08b98f76f7c9a1f4fe9fc967c784c5a071fa8d93cf7e1" +checksum = "224399e74b87b5f3557511d98dff8b14089b3dadafcab6bb93eab67d3aace965" dependencies = [ - "windows-sys 0.61.2", + "scopeguard", ] [[package]] -name = "thiserror" -version = "2.0.18" +name = "log" +version = "0.4.30" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "4288b5bcbc7920c07a1149a35cf9590a2aa808e0bc1eafaade0b80947865fbc4" +checksum = "616ec5685824bcc94416c6d4a7a446eea774a31efd7062c8480ba6fd06d7a6e5" + +[[package]] +name = "logos" +version = "0.16.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "eb2c55a318a87600ea870ff8c2012148b44bf18b74fad48d0f835c38c7d07c5f" dependencies = [ - "thiserror-impl", + "logos-derive", ] [[package]] -name = "thiserror-impl" -version = "2.0.18" +name = "logos-codegen" +version = "0.16.1" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "ebc4ee7f67670e9b64d05fa4253e753e016c6c95ff35b89b7941d6b856dec1d5" +checksum = "58b3ffaa284e1350d017a57d04ada118c4583cf260c8fb01e0fe28a2e9cf8970" dependencies = [ + "fnv", "proc-macro2", "quote", + "regex-automata", + "regex-syntax", "syn", ] [[package]] -name = "time" -version = "0.3.47" +name = "logos-derive" +version = "0.16.1" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "743bd48c283afc0388f9b8827b976905fb217ad9e647fae3a379a9283c4def2c" +checksum = "52d3a9855747c17eaf4383823f135220716ab49bea5fbea7dd42cc9a92f8aa31" dependencies = [ - "deranged", - "itoa", - "num-conv", - "powerfmt", - "serde_core", - "time-core", - "time-macros", + "logos-codegen", ] [[package]] -name = "time-core" -version = "0.1.8" +name = "lru" +version = "0.16.4" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "7694e1cfe791f8d31026952abf09c69ca6f6fa4e1a1229e18988f06a04a12dca" +checksum = "7f66e8d5d03f609abc3a39e6f08e4164ebf1447a732906d39eb9b99b7919ef39" [[package]] -name = "time-macros" -version = "0.2.27" +name = "mach2" +version = "0.4.3" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "2e70e4c5a0e0a8a4823ad65dfe1a6930e4f4d756dcd9dd7939022b5e8c501215" +checksum = "d640282b302c0bb0a2a8e0233ead9035e3bed871f0b7e81fe4a1ec829765db44" dependencies = [ - "num-conv", - "time-core", + "libc", ] [[package]] -name = "tinyvec" -version = "1.11.0" +name = "malloc_buf" +version = "0.0.6" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "3e61e67053d25a4e82c844e8424039d9745781b3fc4f32b8d55ed50f5f667ef3" +checksum = "62bb907fe88d54d8d9ce32a3cceab4218ed2f6b7d35617cafe9adf84e43919cb" dependencies = [ - "tinyvec_macros", + "libc", ] [[package]] -name = "tinyvec_macros" -version = "0.1.1" +name = "memchr" +version = "2.8.1" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "1f3ccbac311fea05f86f61904b462b55fb3df8837a366dfc601a0161d0532f20" +checksum = "6b947ae49db0d222b1dbc6b113ce7248a3fc3a6ca21b696717bfc000ba4484d8" [[package]] -name = "typed-arena" -version = "2.0.2" -source = "registry+https://github.com/rust-lang/crates.io-index" +name = "memmap2" +version = "0.2.3" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "723e3ebdcdc5c023db1df315364573789f8857c11b631a2fdfad7c00f5c046b4" +dependencies = [ + "libc", +] + +[[package]] +name = "memmap2" +version = "0.9.10" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "714098028fe011992e1c3962653c96b2d578c4b4bce9036e15ff220319b1e0e3" +dependencies = [ + "libc", +] + +[[package]] +name = "memoffset" +version = "0.9.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "488016bfae457b036d996092f6cb448677611ce4449e970ceaf42695203f218a" +dependencies = [ + "autocfg", +] + +[[package]] +name = "metal" +version = "0.32.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "00c15a6f673ff72ddcc22394663290f870fb224c1bfce55734a75c414150e605" +dependencies = [ + "bitflags 2.11.1", + "block", + "core-graphics-types 0.2.0", + "foreign-types", + "log", + "objc", + "paste", +] + +[[package]] +name = "miette" +version = "7.6.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "5f98efec8807c63c752b5bd61f862c165c115b0a35685bdcfd9238c7aeb592b7" +dependencies = [ + "cfg-if", + "miette-derive", + "serde", + "unicode-width 0.1.14", +] + +[[package]] +name = "miette-derive" +version = "7.6.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "db5b29714e950dbb20d5e6f74f9dcec4edbcc1067bb7f8ed198c097b8c1a818b" +dependencies = [ + "proc-macro2", + "quote", + "syn", +] + +[[package]] +name = "mundy" +version = "0.2.3" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "f32eb0db40f2df2bcfb05c93b8f73938d4c26ce9ac8881f1df0c8d3296921a73" +dependencies = [ + "android-build", + "async-io", + "cfg-if", + "dispatch", + "futures-channel", + "futures-lite", + "jni", + "ndk-context", + "objc2 0.6.4", + "objc2-app-kit 0.3.2", + "objc2-foundation 0.3.2", + "pin-project-lite", + "wasm-bindgen", + "wasm-bindgen-futures", + "web-sys", + "windows 0.62.2", + "zbus", +] + +[[package]] +name = "naga" +version = "27.0.3" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "066cf25f0e8b11ee0df221219010f213ad429855f57c494f995590c861a9a7d8" +dependencies = [ + "arrayvec 0.7.7", + "bit-set", + "bitflags 2.11.1", + "cfg-if", + "cfg_aliases", + "codespan-reporting", + "half", + "hashbrown 0.16.1", + "hexf-parse", + "indexmap 2.14.0", + "libm", + "log", + "num-traits", + "once_cell", + "rustc-hash 1.1.0", + "spirv", + "thiserror 2.0.18", + "unicode-ident", +] + +[[package]] +name = "ndk" +version = "0.9.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "c3f42e7bbe13d351b6bead8286a43aac9534b82bd3cc43e47037f012ebfd62d4" +dependencies = [ + "bitflags 2.11.1", + "jni-sys 0.3.1", + "log", + "ndk-sys", + "num_enum", + "raw-window-handle", + "thiserror 1.0.69", +] + +[[package]] +name = "ndk-context" +version = "0.1.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "27b02d87554356db9e9a873add8782d4ea6e3e58ea071a9adb9a2e8ddb884a8b" + +[[package]] +name = "ndk-sys" +version = "0.6.0+11769913" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "ee6cda3051665f1fb8d9e08fc35c96d5a244fb1be711a03b71118828afc9a873" +dependencies = [ + "jni-sys 0.3.1", +] + +[[package]] +name = "new_debug_unreachable" +version = "1.0.6" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "650eef8c711430f1a879fdd01d4745a7deea475becfb90269c06775983bbf086" + +[[package]] +name = "nonempty" +version = "0.12.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "9737e026353e5cd0736f98eddae28665118eb6f6600902a7f50db585621fecb6" +dependencies = [ + "serde", +] + +[[package]] +name = "num-conv" +version = "0.2.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "521739c6d2bac4aa25192232afe6841231376b2b26d4d9fae5ecf8ca5772e441" + +[[package]] +name = "num-traits" +version = "0.2.19" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "071dfc062690e90b734c0b2273ce72ad0ffa95f0c74596bc250dcfd960262841" +dependencies = [ + "autocfg", + "libm", +] + +[[package]] +name = "num_enum" +version = "0.7.6" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "5d0bca838442ec211fa11de3a8b0e0e8f3a4522575b5c4c06ed722e005036f26" +dependencies = [ + "num_enum_derive", + "rustversion", +] + +[[package]] +name = "num_enum_derive" +version = "0.7.6" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "680998035259dcfcafe653688bf2aa6d3e2dc05e98be6ab46afb089dc84f1df8" +dependencies = [ + "proc-macro-crate", + "proc-macro2", + "quote", + "syn", +] + +[[package]] +name = "objc" +version = "0.2.7" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "915b1b472bc21c53464d6c8461c9d3af805ba1ef837e1cac254428f4a77177b1" +dependencies = [ + "malloc_buf", +] + +[[package]] +name = "objc-sys" +version = "0.3.5" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "cdb91bdd390c7ce1a8607f35f3ca7151b65afc0ff5ff3b34fa350f7d7c7e4310" + +[[package]] +name = "objc2" +version = "0.5.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "46a785d4eeff09c14c487497c162e92766fbb3e4059a71840cecc03d9a50b804" +dependencies = [ + "objc-sys", + "objc2-encode", +] + +[[package]] +name = "objc2" +version = "0.6.4" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "3a12a8ed07aefc768292f076dc3ac8c48f3781c8f2d5851dd3d98950e8c5a89f" +dependencies = [ + "objc2-encode", +] + +[[package]] +name = "objc2-app-kit" +version = "0.2.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "e4e89ad9e3d7d297152b17d39ed92cd50ca8063a89a9fa569046d41568891eff" +dependencies = [ + "bitflags 2.11.1", + "block2 0.5.1", + "libc", + "objc2 0.5.2", + "objc2-core-data 0.2.2", + "objc2-core-image 0.2.2", + "objc2-foundation 0.2.2", + "objc2-quartz-core 0.2.2", +] + +[[package]] +name = "objc2-app-kit" +version = "0.3.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "d49e936b501e5c5bf01fda3a9452ff86dc3ea98ad5f283e1455153142d97518c" +dependencies = [ + "bitflags 2.11.1", + "block2 0.6.2", + "libc", + "objc2 0.6.4", + "objc2-cloud-kit 0.3.2", + "objc2-core-data 0.3.2", + "objc2-core-foundation", + "objc2-core-graphics", + "objc2-core-image 0.3.2", + "objc2-core-text", + "objc2-core-video", + "objc2-foundation 0.3.2", + "objc2-quartz-core 0.3.2", +] + +[[package]] +name = "objc2-cloud-kit" +version = "0.2.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "74dd3b56391c7a0596a295029734d3c1c5e7e510a4cb30245f8221ccea96b009" +dependencies = [ + "bitflags 2.11.1", + "block2 0.5.1", + "objc2 0.5.2", + "objc2-core-location", + "objc2-foundation 0.2.2", +] + +[[package]] +name = "objc2-cloud-kit" +version = "0.3.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "73ad74d880bb43877038da939b7427bba67e9dd42004a18b809ba7d87cee241c" +dependencies = [ + "bitflags 2.11.1", + "objc2 0.6.4", + "objc2-foundation 0.3.2", +] + +[[package]] +name = "objc2-contacts" +version = "0.2.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "a5ff520e9c33812fd374d8deecef01d4a840e7b41862d849513de77e44aa4889" +dependencies = [ + "block2 0.5.1", + "objc2 0.5.2", + "objc2-foundation 0.2.2", +] + +[[package]] +name = "objc2-core-data" +version = "0.2.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "617fbf49e071c178c0b24c080767db52958f716d9eabdf0890523aeae54773ef" +dependencies = [ + "bitflags 2.11.1", + "block2 0.5.1", + "objc2 0.5.2", + "objc2-foundation 0.2.2", +] + +[[package]] +name = "objc2-core-data" +version = "0.3.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "0b402a653efbb5e82ce4df10683b6b28027616a2715e90009947d50b8dd298fa" +dependencies = [ + "bitflags 2.11.1", + "objc2 0.6.4", + "objc2-foundation 0.3.2", +] + +[[package]] +name = "objc2-core-foundation" +version = "0.3.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "2a180dd8642fa45cdb7dd721cd4c11b1cadd4929ce112ebd8b9f5803cc79d536" +dependencies = [ + "bitflags 2.11.1", + "dispatch2", + "objc2 0.6.4", +] + +[[package]] +name = "objc2-core-graphics" +version = "0.3.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "e022c9d066895efa1345f8e33e584b9f958da2fd4cd116792e15e07e4720a807" +dependencies = [ + "bitflags 2.11.1", + "dispatch2", + "objc2 0.6.4", + "objc2-core-foundation", + "objc2-io-surface", +] + +[[package]] +name = "objc2-core-image" +version = "0.2.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "55260963a527c99f1819c4f8e3b47fe04f9650694ef348ffd2227e8196d34c80" +dependencies = [ + "block2 0.5.1", + "objc2 0.5.2", + "objc2-foundation 0.2.2", + "objc2-metal", +] + +[[package]] +name = "objc2-core-image" +version = "0.3.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "e5d563b38d2b97209f8e861173de434bd0214cf020e3423a52624cd1d989f006" +dependencies = [ + "objc2 0.6.4", + "objc2-foundation 0.3.2", +] + +[[package]] +name = "objc2-core-location" +version = "0.2.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "000cfee34e683244f284252ee206a27953279d370e309649dc3ee317b37e5781" +dependencies = [ + "block2 0.5.1", + "objc2 0.5.2", + "objc2-contacts", + "objc2-foundation 0.2.2", +] + +[[package]] +name = "objc2-core-text" +version = "0.3.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "0cde0dfb48d25d2b4862161a4d5fcc0e3c24367869ad306b0c9ec0073bfed92d" +dependencies = [ + "bitflags 2.11.1", + "objc2 0.6.4", + "objc2-core-foundation", + "objc2-core-graphics", +] + +[[package]] +name = "objc2-core-video" +version = "0.3.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "d425caf1df73233f29fd8a5c3e5edbc30d2d4307870f802d18f00d83dc5141a6" +dependencies = [ + "bitflags 2.11.1", + "objc2 0.6.4", + "objc2-core-foundation", + "objc2-core-graphics", + "objc2-io-surface", +] + +[[package]] +name = "objc2-encode" +version = "4.1.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "ef25abbcd74fb2609453eb695bd2f860d389e457f67dc17cafc8b8cbc89d0c33" + +[[package]] +name = "objc2-foundation" +version = "0.2.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "0ee638a5da3799329310ad4cfa62fbf045d5f56e3ef5ba4149e7452dcf89d5a8" +dependencies = [ + "bitflags 2.11.1", + "block2 0.5.1", + "dispatch", + "libc", + "objc2 0.5.2", +] + +[[package]] +name = "objc2-foundation" +version = "0.3.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "e3e0adef53c21f888deb4fa59fc59f7eb17404926ee8a6f59f5df0fd7f9f3272" +dependencies = [ + "bitflags 2.11.1", + "block2 0.6.2", + "libc", + "objc2 0.6.4", + "objc2-core-foundation", +] + +[[package]] +name = "objc2-io-surface" +version = "0.3.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "180788110936d59bab6bd83b6060ffdfffb3b922ba1396b312ae795e1de9d81d" +dependencies = [ + "bitflags 2.11.1", + "objc2 0.6.4", + "objc2-core-foundation", +] + +[[package]] +name = "objc2-link-presentation" +version = "0.2.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "a1a1ae721c5e35be65f01a03b6d2ac13a54cb4fa70d8a5da293d7b0020261398" +dependencies = [ + "block2 0.5.1", + "objc2 0.5.2", + "objc2-app-kit 0.2.2", + "objc2-foundation 0.2.2", +] + +[[package]] +name = "objc2-metal" +version = "0.2.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "dd0cba1276f6023976a406a14ffa85e1fdd19df6b0f737b063b95f6c8c7aadd6" +dependencies = [ + "bitflags 2.11.1", + "block2 0.5.1", + "objc2 0.5.2", + "objc2-foundation 0.2.2", +] + +[[package]] +name = "objc2-quartz-core" +version = "0.2.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "e42bee7bff906b14b167da2bac5efe6b6a07e6f7c0a21a7308d40c960242dc7a" +dependencies = [ + "bitflags 2.11.1", + "block2 0.5.1", + "objc2 0.5.2", + "objc2-foundation 0.2.2", + "objc2-metal", +] + +[[package]] +name = "objc2-quartz-core" +version = "0.3.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "96c1358452b371bf9f104e21ec536d37a650eb10f7ee379fff67d2e08d537f1f" +dependencies = [ + "bitflags 2.11.1", + "objc2 0.6.4", + "objc2-core-foundation", + "objc2-foundation 0.3.2", +] + +[[package]] +name = "objc2-symbols" +version = "0.2.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "0a684efe3dec1b305badae1a28f6555f6ddd3bb2c2267896782858d5a78404dc" +dependencies = [ + "objc2 0.5.2", + "objc2-foundation 0.2.2", +] + +[[package]] +name = "objc2-ui-kit" +version = "0.2.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "b8bb46798b20cd6b91cbd113524c490f1686f4c4e8f49502431415f3512e2b6f" +dependencies = [ + "bitflags 2.11.1", + "block2 0.5.1", + "objc2 0.5.2", + "objc2-cloud-kit 0.2.2", + "objc2-core-data 0.2.2", + "objc2-core-image 0.2.2", + "objc2-core-location", + "objc2-foundation 0.2.2", + "objc2-link-presentation", + "objc2-quartz-core 0.2.2", + "objc2-symbols", + "objc2-uniform-type-identifiers", + "objc2-user-notifications", +] + +[[package]] +name = "objc2-uniform-type-identifiers" +version = "0.2.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "44fa5f9748dbfe1ca6c0b79ad20725a11eca7c2218bceb4b005cb1be26273bfe" +dependencies = [ + "block2 0.5.1", + "objc2 0.5.2", + "objc2-foundation 0.2.2", +] + +[[package]] +name = "objc2-user-notifications" +version = "0.2.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "76cfcbf642358e8689af64cee815d139339f3ed8ad05103ed5eaf73db8d84cb3" +dependencies = [ + "bitflags 2.11.1", + "block2 0.5.1", + "objc2 0.5.2", + "objc2-core-location", + "objc2-foundation 0.2.2", +] + +[[package]] +name = "object" +version = "0.37.3" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "ff76201f031d8863c38aa7f905eca4f53abbfa15f609db4277d44cd8938f33fe" +dependencies = [ + "memchr", +] + +[[package]] +name = "once_cell" +version = "1.21.4" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "9f7c3e4beb33f85d45ae3e3a1792185706c8e16d043238c593331cc7cd313b50" + +[[package]] +name = "orbclient" +version = "0.3.55" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "5df339f526ea9a60e371768d50efc2f2508c7203290731565d1f7a6f71d21747" +dependencies = [ + "libc", + "libredox", +] + +[[package]] +name = "ordered-float" +version = "5.3.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "b7d950ca161dc355eaf28f82b11345ed76c6e1f6eb1f4f4479e0323b9e2fbd0e" +dependencies = [ + "num-traits", +] + +[[package]] +name = "ordered-stream" +version = "0.2.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "9aa2b01e1d916879f73a53d01d1d6cee68adbb31d6d9177a8cfce093cced1d50" +dependencies = [ + "futures-core", + "pin-project-lite", +] + +[[package]] +name = "owned_ttf_parser" +version = "0.25.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "36820e9051aca1014ddc75770aab4d68bc1e9e632f0f5627c4086bc216fb583b" +dependencies = [ + "ttf-parser", +] + +[[package]] +name = "parking" +version = "2.2.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "f38d5652c16fde515bb1ecef450ab0f6a219d619a7274976324d5e377f7dceba" + +[[package]] +name = "parking_lot" +version = "0.12.5" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "93857453250e3077bd71ff98b6a65ea6621a19bb0f559a85248955ac12c45a1a" +dependencies = [ + "lock_api", + "parking_lot_core", +] + +[[package]] +name = "parking_lot_core" +version = "0.9.12" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "2621685985a2ebf1c516881c026032ac7deafcda1a2c9b7850dc81e3dfcb64c1" +dependencies = [ + "cfg-if", + "libc", + "redox_syscall 0.5.18", + "smallvec", + "windows-link", +] + +[[package]] +name = "paste" +version = "1.0.15" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "57c0d7b74b563b49d38dae00a0c37d4d6de9b432382b2892f0574ddcae73fd0a" + +[[package]] +name = "percent-encoding" +version = "2.3.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "9b4f627cb1b25917193a259e49bdad08f671f8d9708acfd5fe0a8c1455d87220" + +[[package]] +name = "petgraph" +version = "0.7.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "3672b37090dbd86368a4145bc067582552b29c27377cad4e0a306c97f9bd7772" +dependencies = [ + "fixedbitset", + "indexmap 2.14.0", +] + +[[package]] +name = "phf_shared" +version = "0.11.3" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "67eabc2ef2a60eb7faa00097bd1ffdb5bd28e62bf39990626a582201b7a754e5" +dependencies = [ + "siphasher", +] + +[[package]] +name = "pico-args" +version = "0.5.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "5be167a7af36ee22fe3115051bc51f6e6c7054c9348e28deb4f49bd6f705a315" + +[[package]] +name = "pin-project" +version = "1.1.13" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "2466b2336ed02bcdca6b294417127b90ec92038d1d5c4fbeac971a922e0e0924" +dependencies = [ + "pin-project-internal", +] + +[[package]] +name = "pin-project-internal" +version = "1.1.13" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "c96395f0a926bc13b1c17622aaddda1ecb55d49c8f1bf9777e4d877800a43f8b" +dependencies = [ + "proc-macro2", + "quote", + "syn", +] + +[[package]] +name = "pin-project-lite" +version = "0.2.17" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "a89322df9ebe1c1578d689c92318e070967d1042b512afbe49518723f4e6d5cd" + +[[package]] +name = "pin-utils" +version = "0.1.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "8b870d8c151b6f2fb93e84a13146138f05d02ed11c7e7c54f8826aaaf7c9f184" + +[[package]] +name = "piper" +version = "0.2.5" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "c835479a4443ded371d6c535cbfd8d31ad92c5d23ae9770a61bc155e4992a3c1" +dependencies = [ + "atomic-waker", + "fastrand", + "futures-io", +] + +[[package]] +name = "pkg-config" +version = "0.3.33" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "19f132c84eca552bf34cab8ec81f1c1dcc229b811638f9d283dceabe58c5569e" + +[[package]] +name = "plain" +version = "0.2.3" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "b4596b6d070b27117e987119b4dac604f3c58cfb0b191112e24771b2faeac1a6" + +[[package]] +name = "polling" +version = "3.11.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "5d0e4f59085d47d8241c88ead0f274e8a0cb551f3625263c05eb8dd897c34218" +dependencies = [ + "cfg-if", + "concurrent-queue", + "hermit-abi", + "pin-project-lite", + "rustix 1.1.4", + "windows-sys 0.61.2", +] + +[[package]] +name = "portable-atomic" +version = "1.13.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "c33a9471896f1c69cecef8d20cbe2f7accd12527ce60845ff44c153bb2a21b49" + +[[package]] +name = "portable-atomic-util" +version = "0.2.7" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "c2a106d1259c23fac8e543272398ae0e3c0b8d33c88ed73d0cc71b0f1d902618" +dependencies = [ + "portable-atomic", +] + +[[package]] +name = "powerfmt" +version = "0.2.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "439ee305def115ba05938db6eb1644ff94165c5ab5e9420d1c1bcedbba909391" + +[[package]] +name = "precomputed-hash" +version = "0.1.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "925383efa346730478fb4838dbe9137d2a47675ad789c546d150a6e1dd4ab31c" + +[[package]] +name = "presser" +version = "0.3.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "e8cf8e6a8aa66ce33f63993ffc4ea4271eb5b0530a9002db8455ea6050c77bfa" + +[[package]] +name = "pretty" +version = "0.12.5" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "0d22152487193190344590e4f30e219cf3fe140d9e7a3fdb683d82aa2c5f4156" +dependencies = [ + "arrayvec 0.5.2", + "typed-arena", + "unicode-width 0.2.2", +] + +[[package]] +name = "proc-macro-crate" +version = "3.5.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "e67ba7e9b2b56446f1d419b1d807906278ffa1a658a8a5d8a39dcb1f5a78614f" +dependencies = [ + "toml_edit", +] + +[[package]] +name = "proc-macro2" +version = "1.0.106" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "8fd00f0bb2e90d81d1044c2b32617f68fcb9fa3bb7640c23e9c748e53fb30934" +dependencies = [ + "unicode-ident", +] + +[[package]] +name = "profiling" +version = "1.0.18" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "3d595e54a326bc53c1c197b32d295e14b169e3cfeaa8dc82b529f947fba6bcf5" + +[[package]] +name = "psm" +version = "0.1.31" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "645dbe486e346d9b5de3ef16ede18c26e6c70ad97418f4874b8b1889d6e761ea" +dependencies = [ + "ar_archive_writer", + "cc", +] + +[[package]] +name = "quick-xml" +version = "0.39.4" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "cdcc8dd4e2f670d309a5f0e83fe36dfdc05af317008fea29144da1a2ac858e5e" +dependencies = [ + "memchr", +] + +[[package]] +name = "quote" +version = "1.0.45" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "41f2619966050689382d2b44f664f4bc593e129785a36d6ee376ddf37259b924" +dependencies = [ + "proc-macro2", +] + +[[package]] +name = "r-efi" +version = "5.3.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "69cdb34c158ceb288df11e18b4bd39de994f6657d83847bdffdbd7f346754b0f" + +[[package]] +name = "r-efi" +version = "6.0.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "f8dcc9c7d52a811697d2151c701e0d08956f92b0e24136cf4cf27b57a6a0d9bf" + +[[package]] +name = "range-alloc" +version = "0.1.5" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "ca45419789ae5a7899559e9512e58ca889e41f04f1f2445e9f4b290ceccd1d08" + +[[package]] +name = "rangemap" +version = "1.7.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "973443cf09a9c8656b574a866ab68dfa19f0867d0340648c7d2f6a71b8a8ea68" + +[[package]] +name = "ratatoskr-build" +version = "0.1.0" +dependencies = [ + "klcompile", +] + +[[package]] +name = "raw-window-handle" +version = "0.6.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "20675572f6f24e9e76ef639bc5552774ed45f1c30e2951e1e99c59888861c539" + +[[package]] +name = "read-fonts" +version = "0.35.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "6717cf23b488adf64b9d711329542ba34de147df262370221940dfabc2c91358" +dependencies = [ + "bytemuck", + "core_maths", + "font-types 0.10.1", +] + +[[package]] +name = "read-fonts" +version = "0.39.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "c4ed38b89c2c77ff968c524145ad65fb010f38af5c7a224b53b81d47ac2daa81" +dependencies = [ + "bytemuck", + "font-types 0.11.3", +] + +[[package]] +name = "redox_syscall" +version = "0.4.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "4722d768eff46b75989dd134e5c353f0d6296e5aaa3132e776cbdb56be7731aa" +dependencies = [ + "bitflags 1.3.2", +] + +[[package]] +name = "redox_syscall" +version = "0.5.18" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "ed2bf2547551a7053d6fdfafda3f938979645c44812fbfcda098faae3f1a362d" +dependencies = [ + "bitflags 2.11.1", +] + +[[package]] +name = "redox_syscall" +version = "0.8.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "5b44b894f2a6e36457d665d1e08c3866add6ed5e70050c1b4ba8a8ddedb02ce7" +dependencies = [ + "bitflags 2.11.1", +] + +[[package]] +name = "ref-cast" +version = "1.0.25" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "f354300ae66f76f1c85c5f84693f0ce81d747e2c3f21a45fef496d89c960bf7d" +dependencies = [ + "ref-cast-impl", +] + +[[package]] +name = "ref-cast-impl" +version = "1.0.25" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "b7186006dcb21920990093f30e3dea63b7d6e977bf1256be20c3563a5db070da" +dependencies = [ + "proc-macro2", + "quote", + "syn", +] + +[[package]] +name = "regalloc2" +version = "0.15.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "de2c52737737f8609e94f975dee22854a2d5c125772d4b1cf292120f4d45c186" +dependencies = [ + "allocator-api2", + "bumpalo", + "hashbrown 0.17.1", + "log", + "rustc-hash 2.1.2", + "smallvec", +] + +[[package]] +name = "regex" +version = "1.12.3" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "e10754a14b9137dd7b1e3e5b0493cc9171fdd105e0ab477f51b72e7f3ac0e276" +dependencies = [ + "aho-corasick", + "memchr", + "regex-automata", + "regex-syntax", +] + +[[package]] +name = "regex-automata" +version = "0.4.14" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "6e1dd4122fc1595e8162618945476892eefca7b88c52820e74af6262213cae8f" +dependencies = [ + "aho-corasick", + "memchr", + "regex-syntax", +] + +[[package]] +name = "regex-syntax" +version = "0.8.10" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "dc897dd8d9e8bd1ed8cdad82b5966c3e0ecae09fb1907d58efaa013543185d0a" + +[[package]] +name = "region" +version = "3.0.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "e6b6ebd13bc009aef9cd476c1310d49ac354d36e240cf1bd753290f3dc7199a7" +dependencies = [ + "bitflags 1.3.2", + "libc", + "mach2", + "windows-sys 0.52.0", +] + +[[package]] +name = "renderdoc-sys" +version = "1.1.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "19b30a45b0cd0bcca8037f3d0dc3421eaf95327a17cad11964fb8179b4fc4832" + +[[package]] +name = "roxmltree" +version = "0.20.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "6c20b6793b5c2fa6553b250154b78d6d0db37e72700ae35fad9387a46f487c97" + +[[package]] +name = "rustc-hash" +version = "1.1.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "08d43f7aa6b08d49f382cde6a7982047c3426db949b1424bc4b7ec9ae12c6ce2" + +[[package]] +name = "rustc-hash" +version = "2.1.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "94300abf3f1ae2e2b8ffb7b58043de3d399c73fa6f4b73826402a5c457614dbe" + +[[package]] +name = "rustc-literal-escaper" +version = "0.0.7" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "8be87abb9e40db7466e0681dc8ecd9dcfd40360cb10b4c8fe24a7c4c3669b198" + +[[package]] +name = "rustc_version" +version = "0.4.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "cfcb3a22ef46e85b45de6ee7e79d063319ebb6594faafcf1c225ea92ab6e9b92" +dependencies = [ + "semver", +] + +[[package]] +name = "rustix" +version = "0.38.44" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "fdb5bc1ae2baa591800df16c9ca78619bf65c0488b41b96ccec5d11220d8c154" +dependencies = [ + "bitflags 2.11.1", + "errno", + "libc", + "linux-raw-sys 0.4.15", + "windows-sys 0.52.0", +] + +[[package]] +name = "rustix" +version = "1.1.4" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "b6fe4565b9518b83ef4f91bb47ce29620ca828bd32cb7e408f0062e9930ba190" +dependencies = [ + "bitflags 2.11.1", + "errno", + "libc", + "linux-raw-sys 0.12.1", + "windows-sys 0.61.2", +] + +[[package]] +name = "rustversion" +version = "1.0.22" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "b39cdef0fa800fc44525c84ccb54a029961a8215f9619753635a9c0d2538d46d" + +[[package]] +name = "same-file" +version = "1.0.6" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "93fc1dc3aaa9bfed95e02e6eadabb4baf7e3078b0bd1b4d7b6b0b68378900502" +dependencies = [ + "winapi-util", +] + +[[package]] +name = "schemars" +version = "0.9.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "4cd191f9397d57d581cddd31014772520aa448f65ef991055d7f61582c65165f" +dependencies = [ + "dyn-clone", + "ref-cast", + "serde", + "serde_json", +] + +[[package]] +name = "schemars" +version = "1.2.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "a2b42f36aa1cd011945615b92222f6bf73c599a102a300334cd7f8dbeec726cc" +dependencies = [ + "dyn-clone", + "ref-cast", + "serde", + "serde_json", +] + +[[package]] +name = "scoped-tls" +version = "1.0.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "e1cf6437eb19a8f4a6cc0f7dca544973b0b78843adbfeb3683d1a94a0024a294" + +[[package]] +name = "scopeguard" +version = "1.2.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "94143f37725109f92c262ed2cf5e59bce7498c01bcc1502d7b9afe439a4e9f49" + +[[package]] +name = "sctk-adwaita" +version = "0.10.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "b6277f0217056f77f1d8f49f2950ac6c278c0d607c45f5ee99328d792ede24ec" +dependencies = [ + "ab_glyph", + "log", + "memmap2 0.9.10", + "smithay-client-toolkit 0.19.2", + "tiny-skia", +] + +[[package]] +name = "self_cell" +version = "1.2.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "b12e76d157a900eb52e81bc6e9f3069344290341720e9178cde2407113ac8d89" + +[[package]] +name = "semver" +version = "1.0.28" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "8a7852d02fc848982e0c167ef163aaff9cd91dc640ba85e263cb1ce46fae51cd" + +[[package]] +name = "serde" +version = "1.0.228" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "9a8e94ea7f378bd32cbbd37198a4a91436180c5bb472411e48b5ec2e2124ae9e" +dependencies = [ + "serde_core", + "serde_derive", +] + +[[package]] +name = "serde_core" +version = "1.0.228" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "41d385c7d4ca58e59fc732af25c3983b67ac852c1a25000afe1175de458b67ad" +dependencies = [ + "serde_derive", +] + +[[package]] +name = "serde_derive" +version = "1.0.228" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "d540f220d3187173da220f885ab66608367b6574e925011a9353e4badda91d79" +dependencies = [ + "proc-macro2", + "quote", + "syn", +] + +[[package]] +name = "serde_json" +version = "1.0.150" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "e8014e44b4736ed0538adeecded0fce2a272f22dc9578a7eb6b2d9993c74cfb9" +dependencies = [ + "indexmap 2.14.0", + "itoa", + "memchr", + "serde", + "serde_core", + "zmij", +] + +[[package]] +name = "serde_repr" +version = "0.1.20" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "175ee3e80ae9982737ca543e96133087cbd9a485eecc3bc4de9c1a37b47ea59c" +dependencies = [ + "proc-macro2", + "quote", + "syn", +] + +[[package]] +name = "serde_with" +version = "3.20.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "e72c1c2cb7b223fafb600a619537a871c2818583d619401b785e7c0b746ccde2" +dependencies = [ + "base64", + "bs58", + "chrono", + "hex", + "indexmap 1.9.3", + "indexmap 2.14.0", + "schemars 0.9.0", + "schemars 1.2.1", + "serde_core", + "serde_json", + "serde_with_macros", + "time", +] + +[[package]] +name = "serde_with_macros" +version = "3.20.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "b90c488738ecb4fb0262f41f43bc40efc5868d9fb744319ddf5f5317f417bfac" +dependencies = [ + "darling", + "proc-macro2", + "quote", + "syn", +] + +[[package]] +name = "sha3" +version = "0.10.9" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "77fd7028345d415a4034cf8777cd4f8ab1851274233b45f84e3d955502d93874" +dependencies = [ + "digest", + "keccak", +] + +[[package]] +name = "shen-cedar-authz" +version = "0.1.0" +dependencies = [ + "cedar-policy", + "shen-rust", +] + +[[package]] +name = "shen-rust" +version = "0.1.0" +dependencies = [ + "cedar-policy", + "cranelift-codegen", + "cranelift-frontend", + "cranelift-jit", + "cranelift-module", + "cranelift-native", + "smallvec", +] + +[[package]] +name = "shen-rust-bin" +version = "0.1.0" +dependencies = [ + "klcompile", + "shen-rust", +] + +[[package]] +name = "shencalc-iced" +version = "0.1.0" +dependencies = [ + "iced", + "shenffi", +] + +[[package]] +name = "shenffi" +version = "0.1.0" +dependencies = [ + "shen-rust", +] + +[[package]] +name = "shengen-rust" +version = "0.1.0" + +[[package]] +name = "shlex" +version = "1.3.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "0fda2ff0d084019ba4d7c6f371c95d8fd75ce3524c3cb8fb653a3023f6323e64" + +[[package]] +name = "signal-hook-registry" +version = "1.4.8" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "c4db69cba1110affc0e9f7bcd48bbf87b3f4fc7c61fc9155afd4c469eb3d6c1b" +dependencies = [ + "errno", + "libc", +] + +[[package]] +name = "simd_cesu8" +version = "1.1.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "94f90157bb87cddf702797c5dadfa0be7d266cdf49e22da2fcaa32eff75b2c33" +dependencies = [ + "rustc_version", + "simdutf8", +] + +[[package]] +name = "simdutf8" +version = "0.1.5" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "e3a9fe34e3e7a50316060351f37187a3f546bce95496156754b601a5fa71b76e" + +[[package]] +name = "siphasher" +version = "1.0.3" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "8ee5873ec9cce0195efcb7a4e9507a04cd49aec9c83d0389df45b1ef7ba2e649" + +[[package]] +name = "skrifa" +version = "0.37.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "8c31071dedf532758ecf3fed987cdb4bd9509f900e026ab684b4ecb81ea49841" +dependencies = [ + "bytemuck", + "read-fonts 0.35.0", +] + +[[package]] +name = "skrifa" +version = "0.42.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "0c34617370ae968efb7161bb2beb517d9084659aae19e24b89e3db25b46e4564" +dependencies = [ + "bytemuck", + "read-fonts 0.39.2", +] + +[[package]] +name = "slab" +version = "0.4.12" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "0c790de23124f9ab44544d7ac05d60440adc586479ce501c1d6d7da3cd8c9cf5" + +[[package]] +name = "slotmap" +version = "1.1.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "bdd58c3c93c3d278ca835519292445cb4b0d4dc59ccfdf7ceadaab3f8aeb4038" +dependencies = [ + "version_check", +] + +[[package]] +name = "smallvec" +version = "1.15.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "67b1b7a3b5fe4f1376887184045fcf45c69e92af734b7aaddc05fb777b6fbd03" + +[[package]] +name = "smithay-client-toolkit" +version = "0.19.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "3457dea1f0eb631b4034d61d4d8c32074caa6cd1ab2d59f2327bd8461e2c0016" +dependencies = [ + "bitflags 2.11.1", + "calloop 0.13.0", + "calloop-wayland-source 0.3.0", + "cursor-icon", + "libc", + "log", + "memmap2 0.9.10", + "rustix 0.38.44", + "thiserror 1.0.69", + "wayland-backend", + "wayland-client", + "wayland-csd-frame", + "wayland-cursor", + "wayland-protocols", + "wayland-protocols-wlr", + "wayland-scanner", + "xkeysym", +] + +[[package]] +name = "smithay-client-toolkit" +version = "0.20.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "0512da38f5e2b31201a93524adb8d3136276fa4fe4aafab4e1f727a82b534cc0" +dependencies = [ + "bitflags 2.11.1", + "calloop 0.14.4", + "calloop-wayland-source 0.4.1", + "cursor-icon", + "libc", + "log", + "memmap2 0.9.10", + "rustix 1.1.4", + "thiserror 2.0.18", + "wayland-backend", + "wayland-client", + "wayland-csd-frame", + "wayland-cursor", + "wayland-protocols", + "wayland-protocols-experimental", + "wayland-protocols-misc", + "wayland-protocols-wlr", + "wayland-scanner", + "xkeysym", +] + +[[package]] +name = "smithay-clipboard" +version = "0.7.3" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "71704c03f739f7745053bde45fa203a46c58d25bc5c4efba1d9a60e9dba81226" +dependencies = [ + "libc", + "smithay-client-toolkit 0.20.0", + "wayland-backend", +] + +[[package]] +name = "smol_str" +version = "0.2.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "dd538fb6910ac1099850255cf94a94df6551fbdd602454387d0adb2d1ca6dead" +dependencies = [ + "serde", +] + +[[package]] +name = "smol_str" +version = "0.3.6" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "4aaa7368fcf4852a4c2dd92df0cace6a71f2091ca0a23391ce7f3a31833f1523" +dependencies = [ + "borsh", + "serde_core", +] + +[[package]] +name = "softbuffer" +version = "0.4.8" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "aac18da81ebbf05109ab275b157c22a653bb3c12cf884450179942f81bcbf6c3" +dependencies = [ + "as-raw-xcb-connection", + "bytemuck", + "fastrand", + "js-sys", + "memmap2 0.9.10", + "ndk", + "objc2 0.6.4", + "objc2-core-foundation", + "objc2-core-graphics", + "objc2-foundation 0.3.2", + "objc2-quartz-core 0.3.2", + "raw-window-handle", + "redox_syscall 0.5.18", + "rustix 1.1.4", + "tiny-xlib", + "tracing", + "wasm-bindgen", + "wayland-backend", + "wayland-client", + "wayland-sys", + "web-sys", + "windows-sys 0.61.2", + "x11rb", +] + +[[package]] +name = "spirv" +version = "0.3.0+sdk-1.3.268.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "eda41003dc44290527a59b13432d4a0379379fa074b70174882adfbdfd917844" +dependencies = [ + "bitflags 2.11.1", +] + +[[package]] +name = "stable_deref_trait" +version = "1.2.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "6ce2be8dc25455e1f91df71bfa12ad37d7af1092ae736f3a6cd0e37bc7810596" + +[[package]] +name = "stacker" +version = "0.1.24" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "640c8cdd92b6b12f5bcb1803ca3bbf5ab96e5e6b6b96b9ab77dabe9e880b3190" +dependencies = [ + "cc", + "cfg-if", + "libc", + "psm", + "windows-sys 0.61.2", +] + +[[package]] +name = "static_assertions" +version = "1.1.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "a2eb9349b6444b326872e140eb1cf5e7c522154d69e7a0ffb0fb81c06b37543f" + +[[package]] +name = "strict-num" +version = "0.1.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "6637bab7722d379c8b41ba849228d680cc12d0a45ba1fa2b48f2a30577a06731" + +[[package]] +name = "string_cache" +version = "0.8.9" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "bf776ba3fa74f83bf4b63c3dcbbf82173db2632ed8452cb2d891d33f459de70f" +dependencies = [ + "new_debug_unreachable", + "parking_lot", + "phf_shared", + "precomputed-hash", +] + +[[package]] +name = "strsim" +version = "0.11.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "7da8b5736845d9f2fcb837ea5d9e2628564b3b043a70948a3f0b778838c5fb4f" + +[[package]] +name = "svg_fmt" +version = "0.4.5" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "0193cc4331cfd2f3d2011ef287590868599a2f33c3e69bc22c1a3d3acf9e02fb" + +[[package]] +name = "swash" +version = "0.2.9" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "0811b01ca2c4e8718760713911feaf4675c24f94e50530a015ec646cfb622f7c" +dependencies = [ + "skrifa 0.42.1", + "yazi", + "zeno", +] + +[[package]] +name = "syn" +version = "2.0.117" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "e665b8803e7b1d2a727f4023456bbbbe74da67099c585258af0ad9c5013b9b99" +dependencies = [ + "proc-macro2", + "quote", + "unicode-ident", +] + +[[package]] +name = "sys-locale" +version = "0.3.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "8eab9a99a024a169fe8a903cf9d4a3b3601109bcc13bd9e3c6fff259138626c4" +dependencies = [ + "libc", +] + +[[package]] +name = "target-lexicon" +version = "0.13.5" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "adb6935a6f5c20170eeceb1a3835a49e12e19d792f6dd344ccc76a985ca5a6ca" + +[[package]] +name = "tempfile" +version = "3.27.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "32497e9a4c7b38532efcdebeef879707aa9f794296a4f0244f6f69e9bc8574bd" +dependencies = [ + "fastrand", + "getrandom 0.4.3", + "once_cell", + "rustix 1.1.4", + "windows-sys 0.61.2", +] + +[[package]] +name = "term" +version = "1.2.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "d8c27177b12a6399ffc08b98f76f7c9a1f4fe9fc967c784c5a071fa8d93cf7e1" +dependencies = [ + "windows-sys 0.61.2", +] + +[[package]] +name = "termcolor" +version = "1.4.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "06794f8f6c5c898b3275aebefa6b8a1cb24cd2c6c79397ab15774837a0bc5755" +dependencies = [ + "winapi-util", +] + +[[package]] +name = "thiserror" +version = "1.0.69" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "b6aaf5339b578ea85b50e080feb250a3e8ae8cfcdff9a461c9ec2904bc923f52" +dependencies = [ + "thiserror-impl 1.0.69", +] + +[[package]] +name = "thiserror" +version = "2.0.18" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "4288b5bcbc7920c07a1149a35cf9590a2aa808e0bc1eafaade0b80947865fbc4" +dependencies = [ + "thiserror-impl 2.0.18", +] + +[[package]] +name = "thiserror-impl" +version = "1.0.69" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "4fee6c4efc90059e10f81e6d42c60a18f76588c3d74cb83a0b242a2b6c7504c1" +dependencies = [ + "proc-macro2", + "quote", + "syn", +] + +[[package]] +name = "thiserror-impl" +version = "2.0.18" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "ebc4ee7f67670e9b64d05fa4253e753e016c6c95ff35b89b7941d6b856dec1d5" +dependencies = [ + "proc-macro2", + "quote", + "syn", +] + +[[package]] +name = "time" +version = "0.3.47" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "743bd48c283afc0388f9b8827b976905fb217ad9e647fae3a379a9283c4def2c" +dependencies = [ + "deranged", + "itoa", + "num-conv", + "powerfmt", + "serde_core", + "time-core", + "time-macros", +] + +[[package]] +name = "time-core" +version = "0.1.8" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "7694e1cfe791f8d31026952abf09c69ca6f6fa4e1a1229e18988f06a04a12dca" + +[[package]] +name = "time-macros" +version = "0.2.27" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "2e70e4c5a0e0a8a4823ad65dfe1a6930e4f4d756dcd9dd7939022b5e8c501215" +dependencies = [ + "num-conv", + "time-core", +] + +[[package]] +name = "tiny-skia" +version = "0.11.4" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "83d13394d44dae3207b52a326c0c85a8bf87f1541f23b0d143811088497b09ab" +dependencies = [ + "arrayref", + "arrayvec 0.7.7", + "bytemuck", + "cfg-if", + "log", + "tiny-skia-path", +] + +[[package]] +name = "tiny-skia-path" +version = "0.11.4" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "9c9e7fc0c2e86a30b117d0462aa261b72b7a99b7ebd7deb3a14ceda95c5bdc93" +dependencies = [ + "arrayref", + "bytemuck", + "strict-num", +] + +[[package]] +name = "tiny-xlib" +version = "0.2.5" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "a90a0ca3ee6a69f2ad28fd11621a4c3f03b371f366be500b64df260c4ffbafb4" +dependencies = [ + "as-raw-xcb-connection", + "ctor", + "libloading", + "pkg-config", + "tracing", +] + +[[package]] +name = "tinyvec" +version = "1.11.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "3e61e67053d25a4e82c844e8424039d9745781b3fc4f32b8d55ed50f5f667ef3" +dependencies = [ + "tinyvec_macros", +] + +[[package]] +name = "tinyvec_macros" +version = "0.1.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "1f3ccbac311fea05f86f61904b462b55fb3df8837a366dfc601a0161d0532f20" + +[[package]] +name = "toml_datetime" +version = "1.1.1+spec-1.1.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "3165f65f62e28e0115a00b2ebdd37eb6f3b641855f9d636d3cd4103767159ad7" +dependencies = [ + "serde_core", +] + +[[package]] +name = "toml_edit" +version = "0.25.12+spec-1.1.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "d2153edc6955a6c354fad8f5efd38b6a8769bdccf9fe50f8e1329f81b0baa5d7" +dependencies = [ + "indexmap 2.14.0", + "toml_datetime", + "toml_parser", + "winnow", +] + +[[package]] +name = "toml_parser" +version = "1.1.2+spec-1.1.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "a2abe9b86193656635d2411dc43050282ca48aa31c2451210f4202550afb7526" +dependencies = [ + "winnow", +] + +[[package]] +name = "tracing" +version = "0.1.44" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "63e71662fa4b2a2c3a26f570f037eb95bb1f85397f3cd8076caed2f026a6d100" +dependencies = [ + "log", + "pin-project-lite", + "tracing-attributes", + "tracing-core", +] + +[[package]] +name = "tracing-attributes" +version = "0.1.31" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "7490cfa5ec963746568740651ac6781f701c9c5ea257c58e057f3ba8cf69e8da" +dependencies = [ + "proc-macro2", + "quote", + "syn", +] + +[[package]] +name = "tracing-core" +version = "0.1.36" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "db97caf9d906fbde555dd62fa95ddba9eecfd14cb388e4f491a66d74cd5fb79a" +dependencies = [ + "once_cell", +] + +[[package]] +name = "ttf-parser" +version = "0.25.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "d2df906b07856748fa3f6e0ad0cbaa047052d4a7dd609e231c4f72cee8c36f31" +dependencies = [ + "core_maths", +] + +[[package]] +name = "typed-arena" +version = "2.0.2" +source = "registry+https://github.com/rust-lang/crates.io-index" checksum = "6af6ae20167a9ece4bcb41af5b80f8a1f1df981f6391189ce00fd257af04126a" [[package]] @@ -1507,12 +4045,35 @@ version = "1.20.0" source = "registry+https://github.com/rust-lang/crates.io-index" checksum = "40ce102ab67701b8526c123c1bab5cbe42d7040ccfd0f64af1a385808d2f43de" +[[package]] +name = "uds_windows" +version = "1.2.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "f2f6fb2847f6742cd76af783a2a2c49e9375d0a111c7bef6f71cd9e738c72d6e" +dependencies = [ + "memoffset", + "tempfile", + "windows-sys 0.61.2", +] + +[[package]] +name = "unicode-bidi" +version = "0.3.18" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "5c1cb5db39152898a79168971543b1cb5020dff7fe43c8dc468b0885f5e29df5" + [[package]] name = "unicode-ident" version = "1.0.24" source = "registry+https://github.com/rust-lang/crates.io-index" checksum = "e6e4313cd5fcd3dad5cafa179702e2b244f760991f45397d14d4ebf38247da75" +[[package]] +name = "unicode-linebreak" +version = "0.1.5" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "3b09c83c3c29d37506a3e260c08c03743a6bb66a9cd432c6934ab501a190571f" + [[package]] name = "unicode-normalization" version = "0.1.25" @@ -1538,6 +4099,12 @@ dependencies = [ "unicode-script", ] +[[package]] +name = "unicode-segmentation" +version = "1.13.3" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "c6f5d3c3b1bf09027a88a6bc961fc00497d651009560b5463668dc81b0fa87a8" + [[package]] name = "unicode-width" version = "0.1.14" @@ -1557,95 +4124,503 @@ source = "registry+https://github.com/rust-lang/crates.io-index" checksum = "ebc1c04c71510c7f702b52b7c350734c9ff1295c464a03335b00bb84fc54f853" [[package]] -name = "version_check" -version = "0.9.5" +name = "uuid" +version = "1.23.3" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "144d6b123cef80b301b8f72a9e2ca4370ddec21950d0a103dd22c437006d2db7" +dependencies = [ + "js-sys", + "serde_core", + "wasm-bindgen", +] + +[[package]] +name = "version_check" +version = "0.9.5" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "0b928f33d975fc6ad9f86c8f283853ad26bdd5b10b7f1542aa2fa15e2289105a" + +[[package]] +name = "walkdir" +version = "2.5.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "29790946404f91d9c5d06f9874efddea1dc06c5efe94541a7d6863108e3a5e4b" +dependencies = [ + "same-file", + "winapi-util", +] + +[[package]] +name = "wasip2" +version = "1.0.4+wasi-0.2.12" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "b67efb37e106e55ce722a510d6b5f9c17f083e5fc79afc2badeb12cc313d9487" +dependencies = [ + "wit-bindgen", +] + +[[package]] +name = "wasm-bindgen" +version = "0.2.122" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "3ed04576f974d2b2fba0f38c51dbc5518011e38c36bf1143164be765528fd409" +dependencies = [ + "cfg-if", + "once_cell", + "rustversion", + "wasm-bindgen-macro", + "wasm-bindgen-shared", +] + +[[package]] +name = "wasm-bindgen-futures" +version = "0.4.72" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "9473dbd2991ae90b6291c3c32c30c6187ac49aa32f9905d1cce280ec1e110b0f" +dependencies = [ + "js-sys", + "wasm-bindgen", +] + +[[package]] +name = "wasm-bindgen-macro" +version = "0.2.122" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "916151b09da36bd82f6615cbf3a419e2f0ba23a03c6160e8e92eb6bd4aa1dec6" +dependencies = [ + "quote", + "wasm-bindgen-macro-support", +] + +[[package]] +name = "wasm-bindgen-macro-support" +version = "0.2.122" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "299047362ccbfce148b67ab7e73349f77748e00c8296f9542adfad2ad82c5c5e" +dependencies = [ + "bumpalo", + "proc-macro2", + "quote", + "syn", + "wasm-bindgen-shared", +] + +[[package]] +name = "wasm-bindgen-shared" +version = "0.2.122" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "9a929b2c61f11ba3e9bc35b50c1f25cb38e0e892c0c231ae2b8cf78d5dad4437" +dependencies = [ + "unicode-ident", +] + +[[package]] +name = "wasmtime-internal-core" +version = "45.0.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "1bdae4b55b15a23d774b15f6e7cd90ae0d0aa17c47c12b4db098b3dd11ba9d58" +dependencies = [ + "hashbrown 0.17.1", + "libm", +] + +[[package]] +name = "wasmtime-internal-jit-icache-coherence" +version = "45.0.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "8a312ba8bb77955dcd44294a223e7f124c3071ff966583d385d3f6a4639c62e3" +dependencies = [ + "cfg-if", + "libc", + "wasmtime-internal-core", + "windows-sys 0.61.2", +] + +[[package]] +name = "wasmtimer" +version = "0.4.3" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "1c598d6b99ea013e35844697fc4670d08339d5cda15588f193c6beedd12f644b" +dependencies = [ + "futures", + "js-sys", + "parking_lot", + "pin-utils", + "slab", + "wasm-bindgen", +] + +[[package]] +name = "wayland-backend" +version = "0.3.15" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "2857dd20b54e916ec7253b3d6b4d5c4d7d4ca2c33c2e11c6c76a99bd8744755d" +dependencies = [ + "cc", + "downcast-rs", + "rustix 1.1.4", + "scoped-tls", + "smallvec", + "wayland-sys", +] + +[[package]] +name = "wayland-client" +version = "0.31.14" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "645c7c96bb74690c3189b5c9cb4ca1627062bb23693a4fad9d8c3de958260144" +dependencies = [ + "bitflags 2.11.1", + "rustix 1.1.4", + "wayland-backend", + "wayland-scanner", +] + +[[package]] +name = "wayland-csd-frame" +version = "0.3.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "625c5029dbd43d25e6aa9615e88b829a5cad13b2819c4ae129fdbb7c31ab4c7e" +dependencies = [ + "bitflags 2.11.1", + "cursor-icon", + "wayland-backend", +] + +[[package]] +name = "wayland-cursor" +version = "0.31.14" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "4a52d18780be9b1314328a3de5f930b73d2200112e3849ca6cb11822793fb34d" +dependencies = [ + "rustix 1.1.4", + "wayland-client", + "xcursor", +] + +[[package]] +name = "wayland-protocols" +version = "0.32.13" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "23d0c813de3daa2ed6520af85a3bd49b0e722a3078506899aa9686fea58dc4b6" +dependencies = [ + "bitflags 2.11.1", + "wayland-backend", + "wayland-client", + "wayland-scanner", +] + +[[package]] +name = "wayland-protocols-experimental" +version = "20250721.0.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "40a1f863128dcaaec790d7b4b396cc9b9a7a079e878e18c47e6c2d2c5a8dcbb1" +dependencies = [ + "bitflags 2.11.1", + "wayland-backend", + "wayland-client", + "wayland-protocols", + "wayland-scanner", +] + +[[package]] +name = "wayland-protocols-misc" +version = "0.3.12" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "6e9567599ef23e09b8dad6e429e5738d4509dfc46b3b21f32841a304d16b29c8" +dependencies = [ + "bitflags 2.11.1", + "wayland-backend", + "wayland-client", + "wayland-protocols", + "wayland-scanner", +] + +[[package]] +name = "wayland-protocols-plasma" +version = "0.3.12" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "2b6d8cf1eb2c1c31ed1f5643c88a6e53538129d4af80030c8cabd1f9fa884d91" +dependencies = [ + "bitflags 2.11.1", + "wayland-backend", + "wayland-client", + "wayland-protocols", + "wayland-scanner", +] + +[[package]] +name = "wayland-protocols-wlr" +version = "0.3.12" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "eb04e52f7836d7c7976c78ca0250d61e33873c34156a2a1fc9474828ec268234" +dependencies = [ + "bitflags 2.11.1", + "wayland-backend", + "wayland-client", + "wayland-protocols", + "wayland-scanner", +] + +[[package]] +name = "wayland-scanner" +version = "0.31.10" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "9c324a910fd86ebdc364a3e61ec1f11737d3b1d6c273c0239ee8ff4bc0d24b4a" +dependencies = [ + "proc-macro2", + "quick-xml", + "quote", +] + +[[package]] +name = "wayland-sys" +version = "0.31.11" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "d8eab23fefc9e41f8e841df4a9c707e8a8c4ed26e944ef69297184de2785e3be" +dependencies = [ + "dlib", + "log", + "once_cell", + "pkg-config", +] + +[[package]] +name = "web-sys" +version = "0.3.99" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "6d621441cfc37b84979402712047321980c178f299193a3589d05b99e8763436" +dependencies = [ + "js-sys", + "wasm-bindgen", +] + +[[package]] +name = "web-time" +version = "1.1.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "5a6580f308b1fad9207618087a65c04e7a10bc77e02c8e84e9b00dd4b12fa0bb" +dependencies = [ + "js-sys", + "wasm-bindgen", +] + +[[package]] +name = "wgpu" +version = "27.0.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "bfe68bac7cde125de7a731c3400723cadaaf1703795ad3f4805f187459cd7a77" +dependencies = [ + "arrayvec 0.7.7", + "bitflags 2.11.1", + "cfg-if", + "cfg_aliases", + "document-features", + "hashbrown 0.16.1", + "js-sys", + "log", + "naga", + "parking_lot", + "portable-atomic", + "profiling", + "raw-window-handle", + "smallvec", + "static_assertions", + "wasm-bindgen", + "wasm-bindgen-futures", + "web-sys", + "wgpu-core", + "wgpu-hal", + "wgpu-types", +] + +[[package]] +name = "wgpu-core" +version = "27.0.3" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "27a75de515543b1897b26119f93731b385a19aea165a1ec5f0e3acecc229cae7" +dependencies = [ + "arrayvec 0.7.7", + "bit-set", + "bit-vec", + "bitflags 2.11.1", + "bytemuck", + "cfg_aliases", + "document-features", + "hashbrown 0.16.1", + "indexmap 2.14.0", + "log", + "naga", + "once_cell", + "parking_lot", + "portable-atomic", + "profiling", + "raw-window-handle", + "rustc-hash 1.1.0", + "smallvec", + "thiserror 2.0.18", + "wgpu-core-deps-apple", + "wgpu-core-deps-emscripten", + "wgpu-core-deps-windows-linux-android", + "wgpu-hal", + "wgpu-types", +] + +[[package]] +name = "wgpu-core-deps-apple" +version = "27.0.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "0772ae958e9be0c729561d5e3fd9a19679bcdfb945b8b1a1969d9bfe8056d233" +dependencies = [ + "wgpu-hal", +] + +[[package]] +name = "wgpu-core-deps-emscripten" +version = "27.0.0" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "0b928f33d975fc6ad9f86c8f283853ad26bdd5b10b7f1542aa2fa15e2289105a" +checksum = "b06ac3444a95b0813ecfd81ddb2774b66220b264b3e2031152a4a29fda4da6b5" +dependencies = [ + "wgpu-hal", +] [[package]] -name = "walkdir" -version = "2.5.0" +name = "wgpu-core-deps-windows-linux-android" +version = "27.0.0" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "29790946404f91d9c5d06f9874efddea1dc06c5efe94541a7d6863108e3a5e4b" +checksum = "71197027d61a71748e4120f05a9242b2ad142e3c01f8c1b47707945a879a03c3" dependencies = [ - "same-file", - "winapi-util", + "wgpu-hal", ] [[package]] -name = "wasm-bindgen" -version = "0.2.122" +name = "wgpu-hal" +version = "27.0.4" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "3ed04576f974d2b2fba0f38c51dbc5518011e38c36bf1143164be765528fd409" +checksum = "5b21cb61c57ee198bc4aff71aeadff4cbb80b927beb912506af9c780d64313ce" dependencies = [ + "android_system_properties", + "arrayvec 0.7.7", + "ash", + "bit-set", + "bitflags 2.11.1", + "block", + "bytemuck", "cfg-if", + "cfg_aliases", + "core-graphics-types 0.2.0", + "glow", + "glutin_wgl_sys", + "gpu-alloc", + "gpu-allocator", + "gpu-descriptor", + "hashbrown 0.16.1", + "js-sys", + "khronos-egl", + "libc", + "libloading", + "log", + "metal", + "naga", + "ndk-sys", + "objc", "once_cell", - "rustversion", - "wasm-bindgen-macro", - "wasm-bindgen-shared", + "ordered-float", + "parking_lot", + "portable-atomic", + "portable-atomic-util", + "profiling", + "range-alloc", + "raw-window-handle", + "renderdoc-sys", + "smallvec", + "thiserror 2.0.18", + "wasm-bindgen", + "web-sys", + "wgpu-types", + "windows 0.58.0", + "windows-core 0.58.0", ] [[package]] -name = "wasm-bindgen-macro" -version = "0.2.122" +name = "wgpu-types" +version = "27.0.1" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "916151b09da36bd82f6615cbf3a419e2f0ba23a03c6160e8e92eb6bd4aa1dec6" +checksum = "afdcf84c395990db737f2dd91628706cb31e86d72e53482320d368e52b5da5eb" dependencies = [ - "quote", - "wasm-bindgen-macro-support", + "bitflags 2.11.1", + "bytemuck", + "js-sys", + "log", + "thiserror 2.0.18", + "web-sys", ] [[package]] -name = "wasm-bindgen-macro-support" -version = "0.2.122" +name = "winapi-util" +version = "0.1.11" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "299047362ccbfce148b67ab7e73349f77748e00c8296f9542adfad2ad82c5c5e" +checksum = "c2a7b1c03c876122aa43f3020e6c3c3ee5c05081c9a00739faf7503aeba10d22" dependencies = [ - "bumpalo", - "proc-macro2", - "quote", - "syn", - "wasm-bindgen-shared", + "windows-sys 0.61.2", ] [[package]] -name = "wasm-bindgen-shared" -version = "0.2.122" +name = "window_clipboard" +version = "0.5.1" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "9a929b2c61f11ba3e9bc35b50c1f25cb38e0e892c0c231ae2b8cf78d5dad4437" +checksum = "d5654226305eaf2dde8853fb482861d28e5dcecbbd40cb88e8393d94bb80d733" dependencies = [ - "unicode-ident", + "clipboard-win", + "clipboard_macos", + "clipboard_wayland", + "clipboard_x11", + "raw-window-handle", + "thiserror 2.0.18", ] [[package]] -name = "wasmtime-internal-core" -version = "45.0.0" +name = "windows" +version = "0.58.0" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "1bdae4b55b15a23d774b15f6e7cd90ae0d0aa17c47c12b4db098b3dd11ba9d58" +checksum = "dd04d41d93c4992d421894c18c8b43496aa748dd4c081bac0dc93eb0489272b6" dependencies = [ - "hashbrown 0.17.1", - "libm", + "windows-core 0.58.0", + "windows-targets", ] [[package]] -name = "wasmtime-internal-jit-icache-coherence" -version = "45.0.0" +name = "windows" +version = "0.62.2" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "8a312ba8bb77955dcd44294a223e7f124c3071ff966583d385d3f6a4639c62e3" +checksum = "527fadee13e0c05939a6a05d5bd6eec6cd2e3dbd648b9f8e447c6518133d8580" dependencies = [ - "cfg-if", - "libc", - "wasmtime-internal-core", - "windows-sys 0.61.2", + "windows-collections", + "windows-core 0.62.2", + "windows-future", + "windows-numerics", ] [[package]] -name = "winapi-util" -version = "0.1.11" +name = "windows-collections" +version = "0.3.2" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "c2a7b1c03c876122aa43f3020e6c3c3ee5c05081c9a00739faf7503aeba10d22" +checksum = "23b2d95af1a8a14a3c7367e1ed4fc9c20e0a26e79551b1454d72583c97cc6610" dependencies = [ - "windows-sys 0.61.2", + "windows-core 0.62.2", +] + +[[package]] +name = "windows-core" +version = "0.58.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "6ba6d44ec8c2591c134257ce647b7ea6b20335bf6379a27dac5f1641fcf59f99" +dependencies = [ + "windows-implement 0.58.0", + "windows-interface 0.58.0", + "windows-result 0.2.0", + "windows-strings 0.1.0", + "windows-targets", ] [[package]] @@ -1654,11 +4629,33 @@ version = "0.62.2" source = "registry+https://github.com/rust-lang/crates.io-index" checksum = "b8e83a14d34d0623b51dce9581199302a221863196a1dde71a7663a4c2be9deb" dependencies = [ - "windows-implement", - "windows-interface", + "windows-implement 0.60.2", + "windows-interface 0.59.3", + "windows-link", + "windows-result 0.4.1", + "windows-strings 0.5.1", +] + +[[package]] +name = "windows-future" +version = "0.3.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "e1d6f90251fe18a279739e78025bd6ddc52a7e22f921070ccdc67dde84c605cb" +dependencies = [ + "windows-core 0.62.2", "windows-link", - "windows-result", - "windows-strings", + "windows-threading", +] + +[[package]] +name = "windows-implement" +version = "0.58.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "2bbd5b46c938e506ecbce286b6628a02171d56153ba733b6c741fc627ec9579b" +dependencies = [ + "proc-macro2", + "quote", + "syn", ] [[package]] @@ -1672,6 +4669,17 @@ dependencies = [ "syn", ] +[[package]] +name = "windows-interface" +version = "0.58.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "053c4c462dc91d3b1504c6fe5a726dd15e216ba718e84a0e46a88fbe5ded3515" +dependencies = [ + "proc-macro2", + "quote", + "syn", +] + [[package]] name = "windows-interface" version = "0.59.3" @@ -1689,6 +4697,25 @@ version = "0.2.1" source = "registry+https://github.com/rust-lang/crates.io-index" checksum = "f0805222e57f7521d6a62e36fa9163bc891acd422f971defe97d64e70d0a4fe5" +[[package]] +name = "windows-numerics" +version = "0.3.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "6e2e40844ac143cdb44aead537bbf727de9b044e107a0f1220392177d15b0f26" +dependencies = [ + "windows-core 0.62.2", + "windows-link", +] + +[[package]] +name = "windows-result" +version = "0.2.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "1d1043d8214f791817bab27572aaa8af63732e11bf84aa21a45a78d6c317ae0e" +dependencies = [ + "windows-targets", +] + [[package]] name = "windows-result" version = "0.4.1" @@ -1698,6 +4725,16 @@ dependencies = [ "windows-link", ] +[[package]] +name = "windows-strings" +version = "0.1.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "4cd9b125c486025df0eabcb585e62173c6c9eddcec5d117d3b6e8c30e2ee4d10" +dependencies = [ + "windows-result 0.2.0", + "windows-targets", +] + [[package]] name = "windows-strings" version = "0.5.1" @@ -1741,6 +4778,15 @@ dependencies = [ "windows_x86_64_msvc", ] +[[package]] +name = "windows-threading" +version = "0.2.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "3949bd5b99cafdf1c7ca86b43ca564028dfe27d66958f2470940f73d86d75b37" +dependencies = [ + "windows-link", +] + [[package]] name = "windows_aarch64_gnullvm" version = "0.52.6" @@ -1789,8 +4835,271 @@ version = "0.52.6" source = "registry+https://github.com/rust-lang/crates.io-index" checksum = "589f6da84c646204747d1270a2a5661ea66ed1cced2631d546fdfb155959f9ec" +[[package]] +name = "winit" +version = "0.30.13" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "a6755fa58a9f8350bd1e472d4c3fcc25f824ec358933bba33306d0b63df5978d" +dependencies = [ + "ahash", + "android-activity", + "atomic-waker", + "bitflags 2.11.1", + "block2 0.5.1", + "bytemuck", + "calloop 0.13.0", + "cfg_aliases", + "concurrent-queue", + "core-foundation 0.9.4", + "core-graphics", + "cursor-icon", + "dpi", + "js-sys", + "libc", + "memmap2 0.9.10", + "ndk", + "objc2 0.5.2", + "objc2-app-kit 0.2.2", + "objc2-foundation 0.2.2", + "objc2-ui-kit", + "orbclient", + "percent-encoding", + "pin-project", + "raw-window-handle", + "redox_syscall 0.4.1", + "rustix 0.38.44", + "sctk-adwaita", + "smithay-client-toolkit 0.19.2", + "smol_str 0.2.2", + "tracing", + "unicode-segmentation", + "wasm-bindgen", + "wasm-bindgen-futures", + "wayland-backend", + "wayland-client", + "wayland-protocols", + "wayland-protocols-plasma", + "web-sys", + "web-time", + "windows-sys 0.52.0", + "x11-dl", + "x11rb", + "xkbcommon-dl", +] + +[[package]] +name = "winnow" +version = "1.0.3" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "0592e1c9d151f854e6fd382574c3a0855250e1d9b2f99d9281c6e6391af352f1" +dependencies = [ + "memchr", +] + +[[package]] +name = "wit-bindgen" +version = "0.57.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "1ebf944e87a7c253233ad6766e082e3cd714b5d03812acc24c318f549614536e" + +[[package]] +name = "x11-dl" +version = "2.21.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "38735924fedd5314a6e548792904ed8c6de6636285cb9fec04d5b1db85c1516f" +dependencies = [ + "libc", + "once_cell", + "pkg-config", +] + +[[package]] +name = "x11rb" +version = "0.13.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "9993aa5be5a26815fe2c3eacfc1fde061fc1a1f094bf1ad2a18bf9c495dd7414" +dependencies = [ + "as-raw-xcb-connection", + "gethostname", + "libc", + "libloading", + "once_cell", + "rustix 1.1.4", + "x11rb-protocol", +] + +[[package]] +name = "x11rb-protocol" +version = "0.13.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "ea6fc2961e4ef194dcbfe56bb845534d0dc8098940c7e5c012a258bfec6701bd" + +[[package]] +name = "xcursor" +version = "0.3.10" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "bec9e4a500ca8864c5b47b8b482a73d62e4237670e5b5f1d6b9e3cae50f28f2b" + +[[package]] +name = "xkbcommon-dl" +version = "0.4.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "d039de8032a9a8856a6be89cea3e5d12fdd82306ab7c94d74e6deab2460651c5" +dependencies = [ + "bitflags 2.11.1", + "dlib", + "log", + "once_cell", + "xkeysym", +] + +[[package]] +name = "xkeysym" +version = "0.2.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "b9cc00251562a284751c9973bace760d86c0276c471b4be569fe6b068ee97a56" + +[[package]] +name = "xml-rs" +version = "0.8.28" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "3ae8337f8a065cfc972643663ea4279e04e7256de865aa66fe25cec5fb912d3f" + +[[package]] +name = "yazi" +version = "0.2.1" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "e01738255b5a16e78bbb83e7fbba0a1e7dd506905cfc53f4622d89015a03fbb5" + +[[package]] +name = "zbus" +version = "5.16.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "eee682d202a77e4a9f3b2c2bdf48a7b28af5c08c34ddf66f98c93e5e39464285" +dependencies = [ + "async-broadcast", + "async-executor", + "async-io", + "async-lock", + "async-process", + "async-recursion", + "async-task", + "async-trait", + "blocking", + "enumflags2", + "event-listener", + "futures-core", + "futures-lite", + "hex", + "libc", + "ordered-stream", + "rustix 1.1.4", + "serde", + "serde_repr", + "tracing", + "uds_windows", + "uuid", + "windows-sys 0.61.2", + "winnow", + "zbus_macros", + "zbus_names", + "zvariant", +] + +[[package]] +name = "zbus_macros" +version = "5.16.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "adf1bd45a81a103745b1757754762a26e8cd01e4532e4d6c8ec431624b80d1d6" +dependencies = [ + "proc-macro-crate", + "proc-macro2", + "quote", + "syn", + "zbus_names", + "zvariant", + "zvariant_utils", +] + +[[package]] +name = "zbus_names" +version = "4.3.2" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "7074f3e50b894eac91750142016d30d0a89be8e67dbfd9704fb875825760e52d" +dependencies = [ + "serde", + "winnow", + "zvariant", +] + +[[package]] +name = "zeno" +version = "0.3.3" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "6df3dc4292935e51816d896edcd52aa30bc297907c26167fec31e2b0c6a32524" + +[[package]] +name = "zerocopy" +version = "0.8.52" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "ce1022995ff5ff5d841ad7d994facc23098cd40152f2c1d11cd607c6f530653f" +dependencies = [ + "zerocopy-derive", +] + +[[package]] +name = "zerocopy-derive" +version = "0.8.52" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "1ae7f38b72ec2a254e2b87ef277cf2cd4fb97cbebf944faa6f33354da0867930" +dependencies = [ + "proc-macro2", + "quote", + "syn", +] + [[package]] name = "zmij" version = "1.0.21" source = "registry+https://github.com/rust-lang/crates.io-index" checksum = "b8848ee67ecc8aedbaf3e4122217aff892639231befc6a1b58d29fff4c2cabaa" + +[[package]] +name = "zvariant" +version = "5.12.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "a192a0bde63360d77a7523c833d4b4ce6070a927e2c53246e4c540b1a3e27be0" +dependencies = [ + "endi", + "enumflags2", + "serde", + "winnow", + "zvariant_derive", + "zvariant_utils", +] + +[[package]] +name = "zvariant_derive" +version = "5.12.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "90bc6cde9c01c511074be97f7ccb6c19d0da89e3f8662e812e999dcfd4638737" +dependencies = [ + "proc-macro-crate", + "proc-macro2", + "quote", + "syn", + "zvariant_utils", +] + +[[package]] +name = "zvariant_utils" +version = "3.4.0" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "1e8535915cfa75547e559d8c68e8139909a4aeee076831e4ef7fc59d8172c4d6" +dependencies = [ + "proc-macro2", + "quote", + "serde", + "syn", + "winnow", +] diff --git a/Cargo.toml b/Cargo.toml index 2085a18..155b727 100644 --- a/Cargo.toml +++ b/Cargo.toml @@ -6,6 +6,7 @@ members = [ "crates/klcompile", "crates/ratatoskr-build", "crates/shenffi", + "crates/shencalc-iced", "bin/shen-rust", "examples/shen-cedar-authz", ] diff --git a/crates/shencalc-iced/Cargo.toml b/crates/shencalc-iced/Cargo.toml new file mode 100644 index 0000000..a438a8d --- /dev/null +++ b/crates/shencalc-iced/Cargo.toml @@ -0,0 +1,14 @@ +[package] +name = "shencalc-iced" +version.workspace = true +edition.workspace = true +license.workspace = true +description = "ShenCalc — a native cross-platform symbolic calculator GUI (iced) over the shen-cas engine." + +[[bin]] +name = "shencalc-iced" +path = "src/main.rs" + +[dependencies] +shenffi = { path = "../shenffi" } +iced = "0.14" diff --git a/crates/shencalc-iced/src/main.rs b/crates/shencalc-iced/src/main.rs new file mode 100644 index 0000000..695b0c6 --- /dev/null +++ b/crates/shencalc-iced/src/main.rs @@ -0,0 +1,283 @@ +//! ShenCalc — a native, cross-platform symbolic calculator GUI. +//! +//! Pure Rust: the [iced] UI talks straight to the embedded shen-cas engine +//! (`shenffi::CasEngine`) — no FFI, no Swift, no MLX. This is the Syntax-mode +//! MVP (the user types shen-cas bracket syntax and the CAS reduces it). English +//! mode (a small local model via `candle` that maps NL → the CAS tool grammar) +//! is the planned next layer. +//! +//! The CAS reducer is deeply recursive and tree-walked, so — exactly like +//! `ShenCAS.swift` — both boot and every reduce run on a dedicated worker thread +//! with a large stack (the default 8 MB overflows on boot). The UI thread talks +//! to that worker over channels and stays responsive. + +use std::sync::mpsc; +use std::thread; + +use iced::futures::channel::oneshot; +use iced::widget::{button, column, container, row, scrollable, text, text_input}; +use iced::{Element, Length, Task}; +use shenffi::CasEngine; + +/// 64 MB — 4× the ~16 MB the reducer needs at depth, matching ShenCAS.swift. +const WORKER_STACK: usize = 64 * 1024 * 1024; + +fn main() -> iced::Result { + // Headless smoke test of the CAS integration (no display needed), so CI and + // `cargo run -- --selftest` can verify the engine without opening a window. + if std::env::args().any(|a| a == "--selftest") { + run_selftest(); + return Ok(()); + } + + iced::application(ShenCalc::boot, ShenCalc::update, ShenCalc::view) + .title("ShenCalc") + .run() +} + +/// One reduce request handed to the worker thread, with a one-shot reply channel. +struct Job { + input: String, + reply: oneshot::Sender, +} + +#[derive(Debug, Clone)] +enum Message { + /// The worker finished booting the CAS (Ok) or failed (Err message). + Ready(Result<(), String>), + InputChanged(String), + Submit, + /// A reduce finished: the original input plus the rendered result. + Computed(String, String), +} + +struct Entry { + input: String, + result: String, +} + +struct ShenCalc { + input: String, + entries: Vec, + ready: bool, + status: String, + /// Outstanding reduces, so the composer can show "working…". + in_flight: usize, + /// Request channel to the worker; `None` if the worker died at boot. + req_tx: Option>, +} + +impl ShenCalc { + fn boot() -> (Self, Task) { + // Spawn the big-stack worker: it boots the engine, reports readiness on + // `ready_tx`, then serves reduce jobs until the request channel closes. + let (req_tx, req_rx) = mpsc::channel::(); + let (ready_tx, ready_rx) = oneshot::channel::>(); + + thread::Builder::new() + .name("shen-cas".into()) + .stack_size(WORKER_STACK) + .spawn(move || worker(req_rx, ready_tx)) + .expect("spawn shen-cas worker"); + + let state = ShenCalc { + input: String::new(), + entries: Vec::new(), + ready: false, + status: "starting engine…".into(), + in_flight: 0, + req_tx: Some(req_tx), + }; + + // Bridge the readiness one-shot into the iced runtime. + let ready = Task::perform( + async move { + ready_rx + .await + .unwrap_or_else(|_| Err("worker exited".into())) + }, + Message::Ready, + ); + (state, ready) + } + + fn update(&mut self, message: Message) -> Task { + match message { + Message::Ready(Ok(())) => { + self.ready = true; + self.status = "engine ready".into(); + Task::none() + } + Message::Ready(Err(e)) => { + self.status = format!("engine failed: {e}"); + self.req_tx = None; + Task::none() + } + Message::InputChanged(s) => { + self.input = s; + Task::none() + } + Message::Submit => self.submit(), + Message::Computed(input, result) => { + self.in_flight = self.in_flight.saturating_sub(1); + self.entries.push(Entry { input, result }); + Task::none() + } + } + } + + fn submit(&mut self) -> Task { + let input = self.input.trim().to_string(); + let Some(tx) = self.req_tx.clone() else { + return Task::none(); + }; + if input.is_empty() || !self.ready { + return Task::none(); + } + self.input.clear(); + self.in_flight += 1; + + Task::perform( + async move { + let (reply_tx, reply_rx) = oneshot::channel(); + let result = if tx + .send(Job { + input: input.clone(), + reply: reply_tx, + }) + .is_ok() + { + reply_rx + .await + .unwrap_or_else(|_| "error: worker gone".into()) + } else { + "error: engine unavailable".into() + }; + (input, result) + }, + |(input, result)| Message::Computed(input, result), + ) + } + + fn view(&self) -> Element<'_, Message> { + let transcript = if self.entries.is_empty() { + column![text( + "A symbolic calculator powered by the shen-cas engine, in pure \ + Rust. Type shen-cas syntax, e.g. D[Sin[x], x]" + ) + .size(15)] + } else { + self.entries.iter().fold(column![].spacing(14), |col, e| { + let is_error = e.result.starts_with("error:"); + col.push( + column![ + text(e.input.as_str()).size(16).font(iced::Font::MONOSPACE), + row![ + text("= ").size(16), + text(e.result.as_str()) + .size(16) + .font(iced::Font::MONOSPACE) + .color(if is_error { + iced::Color::from_rgb(0.9, 0.35, 0.35) + } else { + iced::Color::from_rgb(0.45, 0.85, 0.72) + }), + ], + ] + .spacing(4), + ) + }) + }; + + let working = self.in_flight > 0; + let composer = row![ + text_input("e.g. D[Sin[x], x]", &self.input) + .on_input(Message::InputChanged) + .on_submit(Message::Submit) + .font(iced::Font::MONOSPACE) + .padding(10), + button(text(if working { "…" } else { "=" })) + .on_press(Message::Submit) + .padding(10), + ] + .spacing(8); + + let header = row![ + text("shen·calc").size(22), + iced::widget::Space::new().width(Length::Fill), + text(self.status.as_str()).size(13).color(if self.ready { + iced::Color::from_rgb(0.45, 0.85, 0.72) + } else { + iced::Color::from_rgb(0.85, 0.6, 0.3) + }), + ] + .spacing(8); + + container( + column![ + header, + scrollable(transcript) + .height(Length::Fill) + .width(Length::Fill), + composer, + ] + .spacing(14), + ) + .padding(18) + .into() + } +} + +/// Worker-thread entry: boot the CAS, signal readiness, then serve reduces. +fn worker(req_rx: mpsc::Receiver, ready_tx: oneshot::Sender>) { + let mut engine = match CasEngine::boot() { + Ok(e) => { + let _ = ready_tx.send(Ok(())); + e + } + Err(e) => { + let _ = ready_tx.send(Err(e)); + return; + } + }; + // `recv` blocks until a job arrives; the loop ends when every Sender drops. + while let Ok(job) = req_rx.recv() { + let result = engine.reduce(&job.input); + let _ = job.reply.send(result); + } +} + +/// Headless verification: boot on a big-stack thread and reduce a fixed battery. +fn run_selftest() { + let handle = thread::Builder::new() + .stack_size(WORKER_STACK) + .spawn(|| { + let mut engine = match CasEngine::boot() { + Ok(e) => e, + Err(e) => { + println!("BOOT FAILED: {e}"); + return false; + } + }; + println!("=== ICED SELFTEST START ==="); + let cases = [ + "D[Sin[x], x]", + "Integrate[x^2, x]", + "Factor[x^2 - 1]", + "Solve[x^2 - 4, x]", + "Expand[(x+1)^2]", + "6/4", + "2^10", + ]; + for c in cases { + println!("CASE {c} => {}", engine.reduce(c)); + } + println!("=== ICED SELFTEST DONE ==="); + true + }) + .expect("spawn selftest thread"); + let ok = handle.join().unwrap_or(false); + if !ok { + std::process::exit(1); + } +} diff --git a/crates/shenffi/src/lib.rs b/crates/shenffi/src/lib.rs index 9e89291..f529015 100644 --- a/crates/shenffi/src/lib.rs +++ b/crates/shenffi/src/lib.rs @@ -120,11 +120,17 @@ pub extern "C" fn shen_boot_shaken( if kernel_kl.is_null() { return std::ptr::null_mut(); } - let kernel = unsafe { CStr::from_ptr(kernel_kl) }.to_string_lossy().into_owned(); + let kernel = unsafe { CStr::from_ptr(kernel_kl) } + .to_string_lossy() + .into_owned(); let prog = if prog_kl.is_null() { None } else { - Some(unsafe { CStr::from_ptr(prog_kl) }.to_string_lossy().into_owned()) + Some( + unsafe { CStr::from_ptr(prog_kl) } + .to_string_lossy() + .into_owned(), + ) }; match boot_shaken_inner(&kernel, prog.as_deref()) { Ok(interp) => Box::into_raw(Box::new(ShenCtx { interp })), @@ -174,7 +180,9 @@ pub extern "C" fn shen_cas_reduce(ctx: *mut ShenCtx, src: *const c_char) -> *mut return std::ptr::null_mut(); } let ctx = unsafe { &mut *ctx }; - let input = unsafe { CStr::from_ptr(src) }.to_string_lossy().into_owned(); + let input = unsafe { CStr::from_ptr(src) } + .to_string_lossy() + .into_owned(); let out = match cas_reduce(&mut ctx.interp, &input) { Ok(s) => s, Err(e) => format!("error: {e}"), @@ -205,14 +213,18 @@ fn cas_reduce(interp: &mut Interp, input: &str) -> Result { .get_fn(reduce_sym) .cloned() .ok_or_else(|| "reduce is undefined".to_string())?; - let nf = interp.apply(reduce_fn, vec![ast]).map_err(|e| e.to_string())?; + let nf = interp + .apply(reduce_fn, vec![ast]) + .map_err(|e| e.to_string())?; let pretty_fn = interp .env .get_fn(pretty_sym) .cloned() .ok_or_else(|| "pretty-expr is undefined".to_string())?; - let pretty = interp.apply(pretty_fn, vec![nf]).map_err(|e| e.to_string())?; + let pretty = interp + .apply(pretty_fn, vec![nf]) + .map_err(|e| e.to_string())?; let app_fn = interp .env @@ -229,6 +241,35 @@ fn cas_reduce(interp: &mut Interp, input: &str) -> Result { .ok_or_else(|| "CAS result did not render to a string".to_string()) } +/// Safe Rust API over the embedded shen-cas — for Rust hosts (e.g. the iced +/// desktop app) that link this crate as an `rlib` and don't want the C ABI's +/// raw pointers. Mirrors `shen_cas_boot` / `shen_cas_reduce`. +/// +/// Note: the CAS reducer is deeply recursive and tree-walked, so both `boot` +/// and `reduce` should run on a thread with a large stack (~16 MB minimum; the +/// default 8 MB overflows on boot). See the iced app's worker thread, or +/// `ShenCAS.swift` on the Swift side, for the pattern. +pub struct CasEngine { + interp: Interp, +} + +impl CasEngine { + /// Boots the embedded shen-cas slice (shaken kernel + CAS program). + pub fn boot() -> Result { + boot_shaken_inner(CAS_KERNEL, Some(CAS_PROG)).map(|interp| CasEngine { interp }) + } + + /// Reduces one CAS expression (e.g. `"D[Sin[x],x]"`) to its rendered normal + /// form. Returns `"error: "` on failure rather than erroring, so + /// callers can display the string directly. + pub fn reduce(&mut self, input: &str) -> String { + match cas_reduce(&mut self.interp, input) { + Ok(s) => s, + Err(e) => format!("error: {e}"), + } + } +} + /// Evaluates a Shen expression and returns its rendered value as a freshly /// allocated C string (release with `shen_string_free`). On error the string is /// `"error: "`. Returns NULL only if the arguments are NULL. @@ -242,7 +283,9 @@ pub extern "C" fn shen_eval(ctx: *mut ShenCtx, src: *const c_char) -> *mut c_cha return std::ptr::null_mut(); } let ctx = unsafe { &mut *ctx }; - let src = unsafe { CStr::from_ptr(src) }.to_string_lossy().into_owned(); + let src = unsafe { CStr::from_ptr(src) } + .to_string_lossy() + .into_owned(); let out = match eval_shen(&mut ctx.interp, &src) { Ok(s) => s, Err(e) => format!("error: {e}"), @@ -300,14 +343,18 @@ fn eval_shen(interp: &mut Interp, src: &str) -> Result { .get_fn(head_sym) .cloned() .ok_or_else(|| "head is undefined".to_string())?; - let first = interp.apply(head_fn, vec![forms]).map_err(|e| e.to_string())?; + let first = interp + .apply(head_fn, vec![forms]) + .map_err(|e| e.to_string())?; let eval_fn = interp .env .get_fn(eval_sym) .cloned() .ok_or_else(|| "eval is undefined".to_string())?; - let result = interp.apply(eval_fn, vec![first]).map_err(|e| e.to_string())?; + let result = interp + .apply(eval_fn, vec![first]) + .map_err(|e| e.to_string())?; let app_fn = interp .env From 95f2781b2043e6610c7ba2e311c7868c365bed92 Mon Sep 17 00:00:00 2001 From: Reuben Brooks Date: Sat, 20 Jun 2026 22:01:14 -0500 Subject: [PATCH 4/7] shencalc-iced: humanise output (port MathPretty to Rust) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit The iced app was showing the raw CAS form ([Cos x]); now it renders the same human-readable math as the iOS/macOS apps (cos(x), 3·x², (1/3)·x³, {2, -2}). - pretty.rs: a faithful Rust port of MathPretty.swift — recursive-descent over the bracket S-expression with precedence-aware parenthesisation, superscript exponents, fraction coefficients, and a Head(arg, …) fallback for unrecognised forms. 14-case unit test locks it to the Swift output. - worker applies pretty::render after reduce (same reduce-then-prettify split the Swift apps use at display time). Co-Authored-By: Claude Opus 4.8 --- crates/shencalc-iced/src/main.rs | 9 +- crates/shencalc-iced/src/pretty.rs | 351 +++++++++++++++++++++++++++++ 2 files changed, 358 insertions(+), 2 deletions(-) create mode 100644 crates/shencalc-iced/src/pretty.rs diff --git a/crates/shencalc-iced/src/main.rs b/crates/shencalc-iced/src/main.rs index 695b0c6..05ca230 100644 --- a/crates/shencalc-iced/src/main.rs +++ b/crates/shencalc-iced/src/main.rs @@ -11,6 +11,8 @@ //! with a large stack (the default 8 MB overflows on boot). The UI thread talks //! to that worker over channels and stays responsive. +mod pretty; + use std::sync::mpsc; use std::thread; @@ -242,7 +244,9 @@ fn worker(req_rx: mpsc::Receiver, ready_tx: oneshot::Sender {}", engine.reduce(c)); + let raw = engine.reduce(c); + println!("CASE {c} => raw={raw} pretty={}", pretty::render(&raw)); } println!("=== ICED SELFTEST DONE ==="); true diff --git a/crates/shencalc-iced/src/pretty.rs b/crates/shencalc-iced/src/pretty.rs new file mode 100644 index 0000000..e7dfc91 --- /dev/null +++ b/crates/shencalc-iced/src/pretty.rs @@ -0,0 +1,351 @@ +//! Port of `MathPretty.swift` — renders shen-cas normal-form output (a bracketed +//! S-expression such as `[Times [Power x 2] 3]`) into human-readable math +//! (`3·x²`). Anything it doesn't recognise falls back to function notation +//! (`Head(arg, …)`) rather than leaking raw brackets, and `error:` strings pass +//! through untouched. Kept behaviourally in lock-step with the Swift version so +//! the iced app reads the same as the iOS/macOS apps. + +#[derive(Debug)] +enum Node { + Atom(String), + List(Vec), +} + +/// Precedence context, so we only parenthesise when needed. +#[derive(Clone, Copy, PartialEq)] +enum Ctx { + Top, + Sum, + Product, + Power, + Fn, +} + +/// Render one CAS normal-form string to human-readable math. +pub fn render(cas_output: &str) -> String { + let t = cas_output.trim(); + if t.is_empty() || t.starts_with("error:") { + return cas_output.to_string(); + } + let tokens = tokenize(t); + let mut pos = 0; + match parse(&tokens, &mut pos) { + Some(node) => emit(&node, Ctx::Top), + None => cas_output.to_string(), + } +} + +// MARK: parse + +fn tokenize(s: &str) -> Vec { + let mut out = Vec::new(); + let mut cur = String::new(); + for ch in s.chars() { + match ch { + '[' | ']' => { + if !cur.is_empty() { + out.push(std::mem::take(&mut cur)); + } + out.push(ch.to_string()); + } + ' ' | '\t' | '\n' => { + if !cur.is_empty() { + out.push(std::mem::take(&mut cur)); + } + } + _ => cur.push(ch), + } + } + if !cur.is_empty() { + out.push(cur); + } + out +} + +fn parse(tokens: &[String], pos: &mut usize) -> Option { + let tok = tokens.get(*pos)?.clone(); + *pos += 1; + if tok == "[" { + let mut items = Vec::new(); + while let Some(next) = tokens.get(*pos) { + if next == "]" { + *pos += 1; + break; + } + match parse(tokens, pos) { + Some(n) => items.push(n), + None => break, + } + } + return Some(Node::List(items)); + } + if tok == "]" { + return None; + } + Some(Node::Atom(tok)) +} + +// MARK: emit + +fn emit(node: &Node, parent: Ctx) -> String { + let xs = match node { + Node::Atom(a) => return a.clone(), + Node::List(xs) => xs, + }; + + // Infix binary forms the CAS emits directly, e.g. [3 / 2]. + if xs.len() == 3 { + if let Node::Atom(op) = &xs[1] { + if matches!(op.as_str(), "/" | "+" | "-" | "*" | "^") { + let sep = if op == "/" { + "/".to_string() + } else { + format!(" {op} ") + }; + let s = format!( + "{}{}{}", + emit(&xs[0], Ctx::Product), + sep, + emit(&xs[2], Ctx::Product) + ); + return if op == "/" && parent == Ctx::Power { + format!("({s})") + } else { + s + }; + } + } + } + + let head = match xs.first() { + Some(Node::Atom(h)) => h.as_str(), + _ => return generic(xs), + }; + let args: Vec<&Node> = xs.iter().skip(1).collect(); + let arg0 = |c: Ctx| args.first().map(|a| emit(a, c)).unwrap_or_default(); + + match head { + "Plus" => wrap_if(parent == Ctx::Product || parent == Ctx::Power, sum(&args)), + "Times" => product(&args, parent), + "Power" => power(&args, parent), + "List" => format!( + "{{{}}}", + args.iter() + .map(|a| emit(a, Ctx::Top)) + .collect::>() + .join(", ") + ), + "Exp" => wrap_if(parent == Ctx::Power, format!("e^{}", arg0(Ctx::Power))), + "Log" => format!("ln({})", arg0(Ctx::Fn)), + "Sqrt" => format!("√({})", arg0(Ctx::Fn)), + _ if is_function(head) && args.len() == 1 => { + format!("{}({})", head.to_lowercase(), emit(args[0], Ctx::Fn)) + } + _ => generic(xs), + } +} + +fn is_function(h: &str) -> bool { + matches!( + h, + "Sin" | "Cos" + | "Tan" + | "Sec" + | "Csc" + | "Cot" + | "Sinh" + | "Cosh" + | "Tanh" + | "Arcsin" + | "Arccos" + | "Arctan" + | "Abs" + ) +} + +fn sum(args: &[&Node]) -> String { + let mut result = String::new(); + for (i, term) in args.iter().enumerate() { + let s = emit(term, Ctx::Sum); + if i == 0 { + result = s; + } else if let Some(rest) = s.strip_prefix('-') { + result.push_str(" - "); + result.push_str(rest.trim()); + } else { + result.push_str(" + "); + result.push_str(&s); + } + } + result +} + +fn product(args: &[&Node], parent: Ctx) -> String { + let mut negative = false; + let mut factors: Vec<&Node> = Vec::new(); + for &f in args { + if let Node::Atom(a) = f { + if a == "-1" { + negative = !negative; + continue; + } + } + factors.push(f); + } + // numeric / fraction coefficients first, for natural reading (3·x²). + let mut ordered: Vec<&Node> = Vec::with_capacity(factors.len()); + for &f in &factors { + if is_numeric(f) { + ordered.push(f); + } + } + for &f in &factors { + if !is_numeric(f) { + ordered.push(f); + } + } + let pieces: Vec = ordered + .iter() + .map(|&f| { + let s = emit(f, Ctx::Product); + // bracket fractions used as coefficients: (1/3)·x³ + if let Node::List(l) = f { + if l.len() == 3 { + if let Node::Atom(op) = &l[1] { + if op == "/" { + return format!("({s})"); + } + } + } + } + s + }) + .collect(); + let mut body = if pieces.is_empty() { + "1".to_string() + } else { + pieces.join("·") + }; + if negative { + body = format!("-{body}"); + } + wrap_if(parent == Ctx::Power, body) +} + +fn power(args: &[&Node], parent: Ctx) -> String { + if args.len() != 2 { + let inner = args + .iter() + .map(|a| emit(a, Ctx::Top)) + .collect::>() + .join(", "); + return format!("Power({inner})"); + } + let base_str = emit(args[0], Ctx::Power); + if let Node::Atom(e) = args[1] { + if let Ok(n) = e.parse::() { + if n == 0 { + return "1".to_string(); + } + if n == 1 { + return base_str; + } + if n < 0 { + let denom = if n == -1 { + base_str + } else { + format!("{base_str}{}", superscript(-n)) + }; + return wrap_if(parent == Ctx::Product, format!("1/{denom}")); + } + return format!("{base_str}{}", superscript(n)); + } + } + // non-integer exponent (fraction, symbol): base^(exp) + format!("{base_str}^({})", emit(args[1], Ctx::Power)) +} + +fn is_numeric(n: &Node) -> bool { + match n { + Node::Atom(a) => a.parse::().is_ok(), + // a fraction like [1 / 2] + Node::List(l) => l.len() == 3 && matches!(&l[1], Node::Atom(op) if op == "/"), + } +} + +/// Fallback: render an unrecognised list as Head(arg, …) function notation. +fn generic(xs: &[Node]) -> String { + match xs.first() { + Some(Node::Atom(head)) => { + let args: Vec = xs.iter().skip(1).map(|a| emit(a, Ctx::Top)).collect(); + if args.is_empty() { + head.clone() + } else { + format!("{head}({})", args.join(", ")) + } + } + _ => format!( + "({})", + xs.iter() + .map(|a| emit(a, Ctx::Top)) + .collect::>() + .join(" ") + ), + } +} + +fn wrap_if(cond: bool, s: String) -> String { + if cond { + format!("({s})") + } else { + s + } +} + +fn superscript(n: i64) -> String { + n.to_string() + .chars() + .map(|c| match c { + '0' => '⁰', + '1' => '¹', + '2' => '²', + '3' => '³', + '4' => '⁴', + '5' => '⁵', + '6' => '⁶', + '7' => '⁷', + '8' => '⁸', + '9' => '⁹', + '-' => '⁻', + other => other, + }) + .collect() +} + +#[cfg(test)] +mod tests { + use super::render; + + #[test] + fn matches_swift_mathpretty() { + let cases = [ + ("[Cos x]", "cos(x)"), + ("[Times [Sin x] -1]", "-sin(x)"), + ("[Power [Sec x] 2]", "sec(x)²"), + ("[Times [Power x 2] 3]", "3·x²"), + ("[Times [Power x 3] [1 / 3]]", "(1/3)·x³"), + ("[Plus [Power x 2] [Times x 2] 1]", "x² + 2·x + 1"), + ("[Times [Plus x 1] [Plus x -1]]", "(x + 1)·(x - 1)"), + ("[List 2 -2]", "{2, -2}"), + ("[3 / 2]", "3/2"), + ("1024", "1024"), + ("[Log x]", "ln(x)"), + ("[Power x -1]", "1/x"), + ("[Exp x]", "e^x"), + ("error: bad char .", "error: bad char ."), + ]; + for (input, want) in cases { + assert_eq!(render(input), want, "render({input:?})"); + } + } +} From 8ac18052817a247056e555b871bcc2d51ab33b5e Mon Sep 17 00:00:00 2001 From: Reuben Brooks Date: Sat, 20 Jun 2026 22:38:57 -0500 Subject: [PATCH 5/7] perf(aot): inline/cold-outline three per-step hot leaves (~6% less CPU work) A fresh --kernel-tests leaf profile (post split-TLS/intern-cache round) found three small functions sitting as un-inlined call frames in the per-step hot loop, each because a *cold* error path (format! / ShenError::cancelled string building) bloated an otherwise tiny hot body and blocked LLVM from folding it into its AOT call sites: - is_truthy (the AOT `if` predicate): 55 -> 7 self-samples - charge_step (per-step budget/deadline check): 45 -> 0 (inlined into eval_in) - make_aot_closure / global_value / fn_value: re-probed the intern HashMap on every AOT lambda/value/fn evaluation; routed through the existing pointer-cached intern_static (the AOT call-target path already used it). Each split into a tiny #[inline] hot path + a #[cold] #[inline(never)] error constructor. Behaviour identical (sticky step-budget exhaustion preserved in the outlined charge_step_limited). The work CSE's into eval_in / call sites; the per-step call/return overhead and cold-blob bloat are gone. Measured ~6.2% less CPU work (paired user-CPU min-of-13, B --- BENCHMARKS.md | 34 +++++++++++++++ PERFORMANCE.md | 17 ++++++++ crates/shen-rust/src/aot/runtime.rs | 28 +++++++++--- crates/shen-rust/src/interp/eval.rs | 16 ++++++- scripts/cross-port-bench-4way.sh | 66 +++++++++++++++++++++++++++++ 5 files changed, 153 insertions(+), 8 deletions(-) create mode 100755 scripts/cross-port-bench-4way.sh diff --git a/BENCHMARKS.md b/BENCHMARKS.md index 94d92bb..653b00e 100644 --- a/BENCHMARKS.md +++ b/BENCHMARKS.md @@ -26,6 +26,40 @@ interpreted-dispatch model, not a single hot spot — each remaining local lever measures ≤ ~8%. The tc-cache row is verdict memoization (off by default), not raw speed. +## Cross-port: the wider field (rust vs cl vs lua) + +`scripts/cross-port-bench-4way.sh` extends the headline harness to the two +Shen-Lua execution modes (LuaJIT and PUC Lua 5.4). Same upstream suite, same +machine, interleaved min-of-N. Approximate (measured on a loaded box; the +ordering and the rough multiples are the robust claim — re-run quiet for clean +absolutes): + +| Port | engine | `--kernel-tests` (test exec) | vs shen-cl | +|---|---|---:|---:| +| shen-cl | SBCL (saved image) | ≈ 1.0 s | 1× | +| **shen-rust** | release tree-walk | ≈ 2.5 s | **~2.5×** | +| shen-lua | LuaJIT | ≈ 5.2 s | ~5× | +| shen-lua | PUC Lua 5.4 | ≈ 11.8 s | ~12× | + +Fairness note: shen-rust (AOT kernel in the binary) and shen-cl (saved Lisp +image) boot in ~0; shen-lua loads its kernel from a cache first +(`load_kernel` ≈ 0.04 s LuaJIT / ≈ 0.39 s PUC, per `run-kernel-tests.lua`'s +printed split) — small relative to the multi-second *execution*, so total +wall-clock is a fair execution proxy. **shen-rust is ~2× faster than LuaJIT and +~4.5× faster than PUC Lua here.** + +Why LuaJIT only reaches ~2.3× over PUC Lua (not the usual 5–20×): a Shen port +allocates a fresh closure per `lambda` / `freeze` / partial application, which +shen-lua emits as Lua `MKFUN(n, function(...) end)` (`compiler.lua:823/845`). +That compiles to the `FNEW` bytecode, which LuaJIT's tracer **cannot compile** +(NYI). On the suite, `luajit -jv` records **977 trace aborts on `FNEW`** and +**579 on `UCLO`** (upvalue-close), and **456 traces blacklisted** — so the +hottest closure-allocating paths permanently fall back to the interpreter. This +is *not* a warm-up artifact (blacklisted traces never recompile no matter how +long the process lives); the lever is in the port's codegen (extend shen-lua's +existing freeze free-var hoisting — the `BIND(kbody[N], …)` scheme — to +lambdas / hot loops to cut `FNEW`). See the LuaJIT-warm note for shen-lua. + ## Warm / served: VM vs tree-walker `scripts/warm-bench.sh` (+ `benches/warm_typecheck.rs`) measures a load-once / diff --git a/PERFORMANCE.md b/PERFORMANCE.md index 0aa6e1f..2d8d963 100644 --- a/PERFORMANCE.md +++ b/PERFORMANCE.md @@ -47,6 +47,23 @@ The living, detailed record is in `design/`: filtered closure-capture caching measured −3.5% — the whole-scope memcpy in `capture_used` beats per-creation lookups even with the free-var walk amortized. +5. **Hot-leaf inline / cold-outline round, 2026-06-20** (~6% less CPU work, + paired user-CPU min-of-13, B ShenResult ShenResult { + // Hot path is a single tag decode; keep it tiny so this folds into the + // generated AOT `if` site. The non-boolean diagnostic is cold and outlined + // so its `format!` doesn't block inlining (it was the bulk of this leaf's + // self-time on the kernel-tests profile). if let Some(b) = v.as_bool() { return Ok(b); } match v.as_sym() { Some(s) if s == interp.well_known.k_true => Ok(true), Some(s) if s == interp.well_known.k_false => Ok(false), - _ => Err(ShenError::new(format!("aot: not a boolean: {v:?}"))), + _ => Err(not_a_boolean(v)), } } +#[cold] +#[inline(never)] +fn not_a_boolean(v: &Value) -> ShenError { + ShenError::new(format!("aot: not a boolean: {v:?}")) +} + /// Wrap a Rust closure as a Shen closure value. Used for AOT-compiled lambdas. /// `arity` is the formal-parameter count; partial application works via the same /// path as any other closure. @@ -117,7 +128,7 @@ pub fn is_truthy(interp: &Interp, v: &Value) -> ShenResult { /// and the move-captures hold copies of the same tagged words — the closure body /// is unchanged. Empty when the lambda captures nothing. pub fn make_aot_closure( - name: &str, + name: &'static str, arity: usize, f: F, captures: Vec, @@ -126,7 +137,10 @@ pub fn make_aot_closure( where F: Fn(&mut Interp, &[Value]) -> ShenResult + 'static, { - let sym = interp.intern(name); + // `name` is always an AOT-emitted literal (`""`/`""`); + // route through the pointer-cached path so hot lambda allocation never + // re-probes the intern HashMap. + let sym = interp.intern_static(name); let closure = Closure { name: Some(sym), arity, @@ -137,8 +151,8 @@ where } /// Look up a global. Used for `(value GLOBAL)` form. -pub fn global_value(interp: &mut Interp, name: &str) -> ShenResult { - let sym = interp.intern(name); +pub fn global_value(interp: &mut Interp, name: &'static str) -> ShenResult { + let sym = interp.intern_static(name); interp .env .get_global(sym) @@ -147,8 +161,8 @@ pub fn global_value(interp: &mut Interp, name: &str) -> ShenResult { } /// Look up a function as a value (`(fn NAME)`). -pub fn fn_value(interp: &mut Interp, name: &str) -> ShenResult { - let sym = interp.intern(name); +pub fn fn_value(interp: &mut Interp, name: &'static str) -> ShenResult { + let sym = interp.intern_static(name); interp .env .get_fn(sym) diff --git a/crates/shen-rust/src/interp/eval.rs b/crates/shen-rust/src/interp/eval.rs index 7eb31bb..bbdf286 100644 --- a/crates/shen-rust/src/interp/eval.rs +++ b/crates/shen-rust/src/interp/eval.rs @@ -530,8 +530,22 @@ impl Interp { /// Exhaustion is sticky — `remaining_steps` parks at `Some(0)` so a /// cancellation that slips past a `trap-error` handler re-fires on the /// handler's first step instead of letting evaluation resume. - #[inline] + #[inline(always)] pub(crate) fn charge_step(&mut self) -> ShenResult<()> { + // Default config sets neither budget — fold to one combined branch the + // caller's hot loop can predict-not-taken. Both Options are `None`, so + // this is a single `is_some` test pair with no body. The cold + // exhaustion/deadline machinery is outlined so it never bloats this + // into a real (un-inlined) call frame. + if self.remaining_steps.is_none() && self.deadline.is_none() { + return Ok(()); + } + self.charge_step_limited() + } + + #[cold] + #[inline(never)] + fn charge_step_limited(&mut self) -> ShenResult<()> { if let Some(n) = self.remaining_steps { if n == 0 { return Err(ShenError::cancelled("cancelled: step budget exhausted")); diff --git a/scripts/cross-port-bench-4way.sh b/scripts/cross-port-bench-4way.sh new file mode 100755 index 0000000..1f9adb4 --- /dev/null +++ b/scripts/cross-port-bench-4way.sh @@ -0,0 +1,66 @@ +#!/bin/bash +# 4-way cross-port benchmark on the upstream Shen kernel test suite: +# shen-rust (release), shen-cl (SBCL image), shen-lua under LuaJIT, and +# shen-lua under PUC Lua. Reports min-of-N wall-clock, interleaved to share +# thermal state. The machine has run-to-run variance, so trust the ratio and +# the ordering, not any single absolute (and run it on an UNLOADED machine — +# a background build or video call dominates the signal). +# +# Note on fairness: shen-rust (AOT kernel baked into the binary) and shen-cl +# (saved Lisp image) boot in ~0; shen-lua loads its kernel from a cache +# (~0.04s LuaJIT / ~0.39s PUC) then *executes* the suite. The kernel-load +# fraction is small for all ports, so total wall-clock is a fair proxy for +# execution speed here — but see run-kernel-tests.lua's printed +# load_kernel/initialise split if you want execution-only. +set -euo pipefail +cd "$(dirname "$0")/.." + +N="${1:-5}" +RUST_BIN="target/release/shen-rust" +CL_BIN="../shen-cl/bin/sbcl/shen" +LUA_DIR="../shen-lua" + +run_rust() { ( "$RUST_BIN" --kernel-tests ) ; } +run_cl() { "$CL_BIN" < /tmp/cl-in.shen ; } +run_lua() { ( cd "$LUA_DIR" && "$1" run-kernel-tests.lua ) ; } + +cat > /tmp/cl-in.shen </dev/null 2>/dev/null; } 2>&1 | awk '/^real/{print $2}' ) || t=99999 + awk -v a="$t" -v m="$min" 'BEGIN{exit !(a/dev/null 2>/dev/null; } 2>&1 | awk '/^real/{print $2}') + C[$i]=$( { /usr/bin/time -p bash -c "\"$CL_BIN\" < /tmp/cl-in.shen" >/dev/null 2>/dev/null; } 2>&1 | awk '/^real/{print $2}') + if command -v luajit >/dev/null; then + LJ[$i]=$( { /usr/bin/time -p bash -c "cd \"$LUA_DIR\" && luajit run-kernel-tests.lua" >/dev/null 2>/dev/null; } 2>&1 | awk '/^real/{print $2}') + fi + if command -v lua >/dev/null; then + L[$i]=$( { /usr/bin/time -p bash -c "cd \"$LUA_DIR\" && lua run-kernel-tests.lua" >/dev/null 2>/dev/null; } 2>&1 | awk '/^real/{print $2}') + fi + printf "round %d: rust=%s cl=%s luajit=%s lua=%s\n" "$i" "${R[$i]}" "${C[$i]}" "${LJ[$i]:-NA}" "${L[$i]:-NA}" +done + +mn() { printf '%s\n' "$@" | sort -n | head -1; } +rmin=$(mn "${R[@]}"); cmin=$(mn "${C[@]}") +echo "---" +printf "shen-cl (SBCL) : %ss 1.00x (ref)\n" "$cmin" +awk -v r="$rmin" -v c="$cmin" 'BEGIN{printf "shen-rust (release): %ss %.2fx\n", r, r/c}' +if [ -n "${LJ[1]:-}" ]; then ljmin=$(mn "${LJ[@]}"); awk -v x="$ljmin" -v c="$cmin" 'BEGIN{printf "shen-lua (luajit) : %ss %.2fx\n", x, x/c}'; fi +if [ -n "${L[1]:-}" ]; then lmin=$(mn "${L[@]}"); awk -v x="$lmin" -v c="$cmin" 'BEGIN{printf "shen-lua (PUC lua) : %ss %.2fx\n", x, x/c}'; fi From 23832826dfad931d02fbd1bad9b370435c4e4226 Mon Sep 17 00:00:00 2001 From: Reuben Brooks Date: Sat, 20 Jun 2026 23:20:11 -0500 Subject: [PATCH 6/7] review: fix bench-script timing capture, harden intern_static, correct cross-port claims Addresses the gpt-5.5 review of PR #7: - HIGH (bench script): cross-port-bench-4way.sh redirected /usr/bin/time's stderr to /dev/null *inside* the timed group, before the outer `2>&1 | awk` could read it -> every timing came back empty. Restructured to silence the program's own stdout/stderr inside an inner `sh -c` so only time's report reaches awk. Verified it now emits real numbers. Dropped the dead bench()/ run_* helpers the review flagged. - Fixing the script surfaced a bad doc claim: BENCHMARKS.md asserted "rust ~2x faster than LuaJIT", which compared rust's *internal eval timer* against a *contended* LuaJIT wall-time (apples-to-oranges). Under the consistent harness they are roughly tied (~2.5s). Corrected the section: firm anchors are shen-cl fastest / PUC Lua slowest; rust-vs-LuaJIT is unresolved and must be re-run quiet. Kept the (load-independent) FNEW/UCLO trace-abort finding, reframed accurately. Noted the Lua driver's 0/0 counter readout is a driver bug, not skipped work (suite self-reports 100% pass). - LOW (intern_static): the pointer cache keyed on address alone; a future static-str caller passing a prefix slice of another literal would collide. Now keyed on (addr, len). One extra compare; whole-literal callers unaffected. 134/0 (tree-walk + VM), fmt + clippy clean, intern unit tests pass. Co-Authored-By: Claude Opus 4.8 --- BENCHMARKS.md | 44 ++++++++++++++++++++++---------- crates/shen-rust/src/symbol.rs | 18 ++++++++----- scripts/cross-port-bench-4way.sh | 38 ++++++++++++--------------- 3 files changed, 57 insertions(+), 43 deletions(-) diff --git a/BENCHMARKS.md b/BENCHMARKS.md index 653b00e..c28e230 100644 --- a/BENCHMARKS.md +++ b/BENCHMARKS.md @@ -30,25 +30,41 @@ default), not raw speed. `scripts/cross-port-bench-4way.sh` extends the headline harness to the two Shen-Lua execution modes (LuaJIT and PUC Lua 5.4). Same upstream suite, same -machine, interleaved min-of-N. Approximate (measured on a loaded box; the -ordering and the rough multiples are the robust claim — re-run quiet for clean -absolutes): - -| Port | engine | `--kernel-tests` (test exec) | vs shen-cl | -|---|---|---:|---:| -| shen-cl | SBCL (saved image) | ≈ 1.0 s | 1× | -| **shen-rust** | release tree-walk | ≈ 2.5 s | **~2.5×** | -| shen-lua | LuaJIT | ≈ 5.2 s | ~5× | -| shen-lua | PUC Lua 5.4 | ≈ 11.8 s | ~12× | +machine, interleaved min-of-N, all four timed identically by external +`/usr/bin/time` wall-clock. + +**These numbers have NOT been taken on a quiet machine — treat them as +indicative, not authoritative, and re-run with `cross-port-bench-4way.sh` on an +idle box before quoting.** What is firm (stable across load): **shen-cl is +fastest** (~1.0 s, a saved SBCL image) and **PUC Lua is slowest** (~12–14 s, a +pure interpreter). What is **not** yet resolved: the **shen-rust vs LuaJIT** +ranking — they land close together in the ~2.5 s range and the order flips with +machine load (rust's release tree-walk vs LuaJIT's trace JIT). An earlier draft +of this section claimed "rust ~2× faster than LuaJIT"; that was an +apples-to-oranges error — it compared rust's *internal eval timer* against a +*contended* LuaJIT wall-time. Under the consistent harness they are roughly +comparable. Do not repeat the 2× claim without a clean measurement. + +| Port | engine | indicative wall (loaded box) | status | +|---|---|---:|---| +| shen-cl | SBCL (saved image) | ≈ 1.0 s | firm: fastest | +| **shen-rust** | release tree-walk | ≈ 2.5 s | ~tied with LuaJIT | +| shen-lua | LuaJIT | ≈ 2.5 s | ~tied with rust | +| shen-lua | PUC Lua 5.4 | ≈ 12–14 s | firm: slowest | Fairness note: shen-rust (AOT kernel in the binary) and shen-cl (saved Lisp image) boot in ~0; shen-lua loads its kernel from a cache first (`load_kernel` ≈ 0.04 s LuaJIT / ≈ 0.39 s PUC, per `run-kernel-tests.lua`'s printed split) — small relative to the multi-second *execution*, so total -wall-clock is a fair execution proxy. **shen-rust is ~2× faster than LuaJIT and -~4.5× faster than PUC Lua here.** - -Why LuaJIT only reaches ~2.3× over PUC Lua (not the usual 5–20×): a Shen port +wall-clock is a fair execution proxy. (The Lua driver prints +`Counters: passed=0 failed=0` at the end — a counter-name readout bug in the +driver, not skipped work; the suite genuinely runs and self-reports +`pass rate ... 100%` per test.) + +The interesting LuaJIT finding is independent of the wall-clock ranking: a big +chunk of the suite never JIT-compiles at all, which is why LuaJIT only ties +shen-rust's non-JIT tree-walker and lands in the low end of its usual range over +PUC Lua (~5×) rather than pulling decisively ahead. The cause: a Shen port allocates a fresh closure per `lambda` / `freeze` / partial application, which shen-lua emits as Lua `MKFUN(n, function(...) end)` (`compiler.lua:823/845`). That compiles to the `FNEW` bytecode, which LuaJIT's tracer **cannot compile** diff --git a/crates/shen-rust/src/symbol.rs b/crates/shen-rust/src/symbol.rs index 27e8b59..3a86343 100644 --- a/crates/shen-rust/src/symbol.rs +++ b/crates/shen-rust/src/symbol.rs @@ -53,7 +53,7 @@ impl Hasher for FnvHasher { type BuildFnv = BuildHasherDefault; /// Slot count of the direct-mapped `&'static str`-pointer cache. Power of -/// two; 8192 × 16 B = 128 KB per `Interner`. The kernel has a few thousand +/// two; 8192 × 24 B = 192 KB per `Interner`. The kernel has a few thousand /// distinct AOT callee names, so collisions (two literals mapping to one /// slot) are rare and only cost a re-intern through `by_name`. const PTR_CACHE_SLOTS: usize = 8192; @@ -76,8 +76,11 @@ pub struct Interner { /// loser re-interns through `by_name` — correct because `intern` is /// idempotent. Per-`Interner` (never process-global), so it stays /// correct even when several interpreters with different id assignments - /// coexist. - by_ptr: Box<[(usize, SymId)]>, + /// coexist. Keyed by `(addr, len)`, not addr alone: a `&'static str` that + /// is a *prefix slice* of another literal shares its start address, so the + /// length disambiguates them (today's callers pass whole literals, but the + /// helper is `pub`, so this keeps it sound for any static-str caller). + by_ptr: Box<[(usize, usize, SymId)]>, } impl Default for Interner { @@ -85,7 +88,7 @@ impl Default for Interner { Interner { names: Vec::new(), by_name: HashMap::default(), - by_ptr: vec![(0, SymId(0)); PTR_CACHE_SLOTS].into_boxed_slice(), + by_ptr: vec![(0, 0, SymId(0)); PTR_CACHE_SLOTS].into_boxed_slice(), } } } @@ -114,16 +117,17 @@ impl Interner { #[inline] pub fn intern_static(&mut self, name: &'static str) -> SymId { let key = name.as_ptr() as usize; + let len = name.len(); // Literals are ≥1-byte aligned with addresses spread across rodata; // fold a high-bit window in so neighbours in one object file don't // contend for adjacent-slot runs. let idx = ((key >> 3) ^ (key >> 16)) & (PTR_CACHE_SLOTS - 1); - let (k, id) = self.by_ptr[idx]; - if k == key { + let (k, l, id) = self.by_ptr[idx]; + if k == key && l == len { return id; } let id = self.intern(name); - self.by_ptr[idx] = (key, id); + self.by_ptr[idx] = (key, len, id); id } diff --git a/scripts/cross-port-bench-4way.sh b/scripts/cross-port-bench-4way.sh index 1f9adb4..0ab25cd 100755 --- a/scripts/cross-port-bench-4way.sh +++ b/scripts/cross-port-bench-4way.sh @@ -20,47 +20,41 @@ RUST_BIN="target/release/shen-rust" CL_BIN="../shen-cl/bin/sbcl/shen" LUA_DIR="../shen-lua" -run_rust() { ( "$RUST_BIN" --kernel-tests ) ; } -run_cl() { "$CL_BIN" < /tmp/cl-in.shen ; } -run_lua() { ( cd "$LUA_DIR" && "$1" run-kernel-tests.lua ) ; } - cat > /tmp/cl-in.shen </dev/null 2>/dev/null; } 2>&1 | awk '/^real/{print $2}' ) || t=99999 - awk -v a="$t" -v m="$min" 'BEGIN{exit !(a the pipe -> awk. (Redirecting the program's +# stderr at the outer level would also swallow time's own output, which writes +# to fd 2 — that was the bug this structure avoids.) +timeit() { + { /usr/bin/time -p sh -c "$1 >/dev/null 2>&1"; } 2>&1 | awk '/^real/{print $2}' } +mn() { printf '%s\n' "$@" | sort -n | head -1; } + echo "== 4-way kernel-tests, min-of-$N (interleaved) ==" -# Interleave: one round-robin pass per iteration keeps thermal state shared. declare -a R C LJ L for i in $(seq 1 "$N"); do - R[$i]=$( { /usr/bin/time -p "$RUST_BIN" --kernel-tests >/dev/null 2>/dev/null; } 2>&1 | awk '/^real/{print $2}') - C[$i]=$( { /usr/bin/time -p bash -c "\"$CL_BIN\" < /tmp/cl-in.shen" >/dev/null 2>/dev/null; } 2>&1 | awk '/^real/{print $2}') + R[$i]=$(timeit "'$RUST_BIN' --kernel-tests") + C[$i]=$(timeit "'$CL_BIN' < /tmp/cl-in.shen") if command -v luajit >/dev/null; then - LJ[$i]=$( { /usr/bin/time -p bash -c "cd \"$LUA_DIR\" && luajit run-kernel-tests.lua" >/dev/null 2>/dev/null; } 2>&1 | awk '/^real/{print $2}') + LJ[$i]=$(timeit "cd '$LUA_DIR' && luajit run-kernel-tests.lua") fi if command -v lua >/dev/null; then - L[$i]=$( { /usr/bin/time -p bash -c "cd \"$LUA_DIR\" && lua run-kernel-tests.lua" >/dev/null 2>/dev/null; } 2>&1 | awk '/^real/{print $2}') + L[$i]=$(timeit "cd '$LUA_DIR' && lua run-kernel-tests.lua") fi - printf "round %d: rust=%s cl=%s luajit=%s lua=%s\n" "$i" "${R[$i]}" "${C[$i]}" "${LJ[$i]:-NA}" "${L[$i]:-NA}" + printf "round %d: rust=%s cl=%s luajit=%s lua=%s\n" \ + "$i" "${R[$i]:-NA}" "${C[$i]:-NA}" "${LJ[$i]:-NA}" "${L[$i]:-NA}" done -mn() { printf '%s\n' "$@" | sort -n | head -1; } rmin=$(mn "${R[@]}"); cmin=$(mn "${C[@]}") echo "---" printf "shen-cl (SBCL) : %ss 1.00x (ref)\n" "$cmin" awk -v r="$rmin" -v c="$cmin" 'BEGIN{printf "shen-rust (release): %ss %.2fx\n", r, r/c}' if [ -n "${LJ[1]:-}" ]; then ljmin=$(mn "${LJ[@]}"); awk -v x="$ljmin" -v c="$cmin" 'BEGIN{printf "shen-lua (luajit) : %ss %.2fx\n", x, x/c}'; fi -if [ -n "${L[1]:-}" ]; then lmin=$(mn "${L[@]}"); awk -v x="$lmin" -v c="$cmin" 'BEGIN{printf "shen-lua (PUC lua) : %ss %.2fx\n", x, x/c}'; fi +if [ -n "${L[1]:-}" ]; then lmin=$(mn "${L[@]}"); awk -v x="$lmin" -v c="$cmin" 'BEGIN{printf "shen-lua (PUC lua) : %ss %.2fx\n", x, x/c}'; fi From 7bead81a2969a0a73bcb7317cd07ea24b9375d35 Mon Sep 17 00:00:00 2001 From: Reuben Brooks Date: Tue, 23 Jun 2026 21:25:44 -0500 Subject: [PATCH 7/7] shenffi: drop CAS + iced app, keep a generic C ABI Move the shen-cas engine (CasEngine, the shen_cas_* C ABI, and the tree-shaken cas-*.kl slice) out of shenffi into the shen-calc repo's new cas-engine crate, and delete the duplicate crates/shencalc-iced (the canonical iced app lives in shen-calc). shenffi is now a program-agnostic embedding surface over the interpreter. Dropping shencalc-iced from the workspace members removes the entire iced/wgpu/wayland dependency tree from Cargo.lock. Co-Authored-By: Claude Opus 4.8 --- Cargo.lock | 4555 ++++----------------------- Cargo.toml | 1 - crates/shencalc-iced/Cargo.toml | 14 - crates/shencalc-iced/src/main.rs | 288 -- crates/shencalc-iced/src/pretty.rs | 351 --- crates/shenffi/README.md | 44 +- crates/shenffi/build-xcframework.sh | 3 +- crates/shenffi/cas/cas-all.kl | 1943 ------------ crates/shenffi/cas/cas-kernel.kl | 1272 -------- crates/shenffi/include/shenffi.h | 11 +- crates/shenffi/src/lib.rs | 123 - crates/shenffi/swift/cas-demo.swift | 34 - 12 files changed, 637 insertions(+), 8002 deletions(-) delete mode 100644 crates/shencalc-iced/Cargo.toml delete mode 100644 crates/shencalc-iced/src/main.rs delete mode 100644 crates/shencalc-iced/src/pretty.rs delete mode 100644 crates/shenffi/cas/cas-all.kl delete mode 100644 crates/shenffi/cas/cas-kernel.kl delete mode 100644 crates/shenffi/swift/cas-demo.swift diff --git a/Cargo.lock b/Cargo.lock index 9d609c9..2aeda5b 100644 --- a/Cargo.lock +++ b/Cargo.lock @@ -2,35 +2,6 @@ # It is not intended for manual editing. version = 4 -[[package]] -name = "ab_glyph" -version = "0.2.32" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "01c0457472c38ea5bd1c3b5ada5e368271cb550be7a4ca4a0b4634e9913f6cc2" -dependencies = [ - "ab_glyph_rasterizer", - "owned_ttf_parser", -] - -[[package]] -name = "ab_glyph_rasterizer" -version = "0.1.10" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "366ffbaa4442f4684d91e2cd7c5ea7c4ed8add41959a31447066e279e432b618" - -[[package]] -name = "ahash" -version = "0.8.12" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "5a15f179cd60c4584b8a8c596927aadc462e27f2ca70c04e0071964a73ba7a75" -dependencies = [ - "cfg-if", - "getrandom 0.3.4", - "once_cell", - "version_check", - "zerocopy", -] - [[package]] name = "aho-corasick" version = "1.1.4" @@ -46,40 +17,6 @@ version = "0.2.21" source = "registry+https://github.com/rust-lang/crates.io-index" checksum = "683d7910e743518b0e34f1186f92494becacb047c7b6bf616c96772180fef923" -[[package]] -name = "android-activity" -version = "0.6.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "0f2a1bb052857d5dd49572219344a7332b31b76405648eabac5bc68978251bcd" -dependencies = [ - "android-properties", - "bitflags 2.11.1", - "cc", - "jni", - "libc", - "log", - "ndk", - "ndk-context", - "ndk-sys", - "num_enum", - "thiserror 2.0.18", -] - -[[package]] -name = "android-build" -version = "0.1.4" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "f9fc9904ad2ad097c3c1cfe2eacaaf0fc24710936fa9ed941cb310b7c6ed2ab7" -dependencies = [ - "windows-sys 0.52.0", -] - -[[package]] -name = "android-properties" -version = "0.2.2" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "fc7eb209b1518d6bb87b283c20095f5228ecda460da70b44f0802523dea6da04" - [[package]] name = "android_system_properties" version = "0.1.5" @@ -110,30 +47,12 @@ version = "1.4.2" source = "registry+https://github.com/rust-lang/crates.io-index" checksum = "c3d036a3c4ab069c7b410a2ce876bd74808d2d0888a82667669f8e783a898bf1" -[[package]] -name = "arrayref" -version = "0.3.9" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "76a2e8124351fda1ef8aaaa3bbd7ebbcb486bbcd4225aca0aa0d84bb2db8fecb" - [[package]] name = "arrayvec" version = "0.5.2" source = "registry+https://github.com/rust-lang/crates.io-index" checksum = "23b62fc65de8e4e7f52534fb52b0f3ed04746ae267519eef2a83941e8085068b" -[[package]] -name = "arrayvec" -version = "0.7.7" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "f02882884d3e1bc524fb12c79f107f6ad0e1cfd498c536ffb494301740995dfe" - -[[package]] -name = "as-raw-xcb-connection" -version = "1.0.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "175571dd1d178ced59193a6fc02dde1b972eb0bc56c892cde9beeceac5bf0f6b" - [[package]] name = "ascii-canvas" version = "4.0.0" @@ -143,152 +62,6 @@ dependencies = [ "term", ] -[[package]] -name = "ash" -version = "0.38.0+1.3.281" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "0bb44936d800fea8f016d7f2311c6a4f97aebd5dc86f09906139ec848cf3a46f" -dependencies = [ - "libloading", -] - -[[package]] -name = "async-broadcast" -version = "0.7.2" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "435a87a52755b8f27fcf321ac4f04b2802e337c8c4872923137471ec39c37532" -dependencies = [ - "event-listener", - "event-listener-strategy", - "futures-core", - "pin-project-lite", -] - -[[package]] -name = "async-channel" -version = "2.5.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "924ed96dd52d1b75e9c1a3e6275715fd320f5f9439fb5a4a11fa51f4221158d2" -dependencies = [ - "concurrent-queue", - "event-listener-strategy", - "futures-core", - "pin-project-lite", -] - -[[package]] -name = "async-executor" -version = "1.14.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "c96bf972d85afc50bf5ab8fe2d54d1586b4e0b46c97c50a0c9e71e2f7bcd812a" -dependencies = [ - "async-task", - "concurrent-queue", - "fastrand", - "futures-lite", - "pin-project-lite", - "slab", -] - -[[package]] -name = "async-io" -version = "2.6.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "456b8a8feb6f42d237746d4b3e9a178494627745c3c56c6ea55d92ba50d026fc" -dependencies = [ - "autocfg", - "cfg-if", - "concurrent-queue", - "futures-io", - "futures-lite", - "parking", - "polling", - "rustix 1.1.4", - "slab", - "windows-sys 0.61.2", -] - -[[package]] -name = "async-lock" -version = "3.4.2" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "290f7f2596bd5b78a9fec8088ccd89180d7f9f55b94b0576823bbbdc72ee8311" -dependencies = [ - "event-listener", - "event-listener-strategy", - "pin-project-lite", -] - -[[package]] -name = "async-process" -version = "2.5.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "fc50921ec0055cdd8a16de48773bfeec5c972598674347252c0399676be7da75" -dependencies = [ - "async-channel", - "async-io", - "async-lock", - "async-signal", - "async-task", - "blocking", - "cfg-if", - "event-listener", - "futures-lite", - "rustix 1.1.4", -] - -[[package]] -name = "async-recursion" -version = "1.1.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "3b43422f69d8ff38f95f1b2bb76517c91589a924d1559a0e935d7c8ce0274c11" -dependencies = [ - "proc-macro2", - "quote", - "syn", -] - -[[package]] -name = "async-signal" -version = "0.2.14" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "52b5aaafa020cf5053a01f2a60e8ff5dccf550f0f77ec54a4e47285ac2bab485" -dependencies = [ - "async-io", - "async-lock", - "atomic-waker", - "cfg-if", - "futures-core", - "futures-io", - "rustix 1.1.4", - "signal-hook-registry", - "slab", - "windows-sys 0.61.2", -] - -[[package]] -name = "async-task" -version = "4.7.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "8b75356056920673b02621b35afd0f7dda9306d03c79a30f5c56c44cf256e3de" - -[[package]] -name = "async-trait" -version = "0.1.89" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "9035ad2d096bed7955a320ee7e2230574d28fd3c3a0f186cbea1ff3c7eed5dbb" -dependencies = [ - "proc-macro2", - "quote", - "syn", -] - -[[package]] -name = "atomic-waker" -version = "1.1.2" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "1505bd5d3d116872e7271a6d4e16d81d0c8570876c8de68093a09ac269d8aac0" - [[package]] name = "autocfg" version = "1.5.1" @@ -328,12 +101,6 @@ version = "2.11.1" source = "registry+https://github.com/rust-lang/crates.io-index" checksum = "c4512299f36f043ab09a583e57bceb5a5aab7a73db1805848e8fef3c9e8c78b3" -[[package]] -name = "block" -version = "0.1.6" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "0d8c1fef690941d3e7788d328517591fecc684c084084702d6ff1641e993699a" - [[package]] name = "block-buffer" version = "0.10.4" @@ -343,37 +110,6 @@ dependencies = [ "generic-array", ] -[[package]] -name = "block2" -version = "0.5.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "2c132eebf10f5cad5289222520a4a058514204aed6d791f1cf4fe8088b82d15f" -dependencies = [ - "objc2 0.5.2", -] - -[[package]] -name = "block2" -version = "0.6.2" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "cdeb9d870516001442e364c5220d3574d2da8dc765554b4a617230d33fa58ef5" -dependencies = [ - "objc2 0.6.4", -] - -[[package]] -name = "blocking" -version = "1.6.2" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "e83f8d02be6967315521be875afa792a316e28d57b5a2d401897e2a7921b7f21" -dependencies = [ - "async-channel", - "async-task", - "futures-io", - "futures-lite", - "piper", -] - [[package]] name = "borsh" version = "1.6.1" @@ -402,83 +138,12 @@ dependencies = [ "allocator-api2", ] -[[package]] -name = "bytemuck" -version = "1.25.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "c8efb64bd706a16a1bdde310ae86b351e4d21550d98d056f22f8a7f7a2183fec" -dependencies = [ - "bytemuck_derive", -] - -[[package]] -name = "bytemuck_derive" -version = "1.10.2" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "f9abbd1bc6865053c427f7198e6af43bfdedc55ab791faed4fbd361d789575ff" -dependencies = [ - "proc-macro2", - "quote", - "syn", -] - [[package]] name = "bytes" version = "1.11.1" source = "registry+https://github.com/rust-lang/crates.io-index" checksum = "1e748733b7cbc798e1434b6ac524f0c1ff2ab456fe201501e6497c8417a4fc33" -[[package]] -name = "calloop" -version = "0.13.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "b99da2f8558ca23c71f4fd15dc57c906239752dd27ff3c00a1d56b685b7cbfec" -dependencies = [ - "bitflags 2.11.1", - "log", - "polling", - "rustix 0.38.44", - "slab", - "thiserror 1.0.69", -] - -[[package]] -name = "calloop" -version = "0.14.4" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "4dbf9978365bac10f54d1d4b04f7ce4427e51f71d61f2fe15e3fed5166474df7" -dependencies = [ - "bitflags 2.11.1", - "polling", - "rustix 1.1.4", - "slab", - "tracing", -] - -[[package]] -name = "calloop-wayland-source" -version = "0.3.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "95a66a987056935f7efce4ab5668920b5d0dac4a7c99991a67395f13702ddd20" -dependencies = [ - "calloop 0.13.0", - "rustix 0.38.44", - "wayland-backend", - "wayland-client", -] - -[[package]] -name = "calloop-wayland-source" -version = "0.4.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "138efcf0940a02ebf0cc8d1eff41a1682a46b431630f4c52450d6265876021fa" -dependencies = [ - "calloop 0.14.4", - "rustix 1.1.4", - "wayland-backend", - "wayland-client", -] - [[package]] name = "cc" version = "1.2.62" @@ -486,8 +151,6 @@ source = "registry+https://github.com/rust-lang/crates.io-index" checksum = "a1dce859f0832a7d088c4f1119888ab94ef4b5d6795d1ce05afb7fe159d79f98" dependencies = [ "find-msvc-tools", - "jobserver", - "libc", "shlex", ] @@ -507,8 +170,8 @@ dependencies = [ "serde", "serde_json", "serde_with", - "smol_str 0.3.6", - "thiserror 2.0.18", + "smol_str", + "thiserror", ] [[package]] @@ -533,9 +196,9 @@ dependencies = [ "serde", "serde_json", "serde_with", - "smol_str 0.3.6", + "smol_str", "stacker", - "thiserror 2.0.18", + "thiserror", "unicode-security", ] @@ -551,7 +214,7 @@ dependencies = [ "miette", "pretty", "regex", - "smol_str 0.3.6", + "smol_str", ] [[package]] @@ -579,256 +242,99 @@ dependencies = [ ] [[package]] -name = "clipboard-win" -version = "5.4.1" +name = "core-foundation-sys" +version = "0.8.7" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "bde03770d3df201d4fb868f2c9c59e66a3e4e2bd06692a0fe701e7103c7e84d4" -dependencies = [ - "error-code", -] +checksum = "773648b94d0e5d620f64f280777445740e61fe701025087ec8b57f45c791888b" [[package]] -name = "clipboard_macos" -version = "0.1.1" +name = "cpufeatures" +version = "0.2.17" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "9b7f4aaa047ba3c3630b080bb9860894732ff23e2aee290a418909aa6d5df38f" +checksum = "59ed5838eebb26a2bb2e58f6d5b5316989ae9d08bab10e0e6d103e656d1b0280" dependencies = [ - "objc2 0.5.2", - "objc2-app-kit 0.2.2", - "objc2-foundation 0.2.2", + "libc", ] [[package]] -name = "clipboard_wayland" -version = "0.2.2" +name = "cranelift-assembler-x64" +version = "0.132.0" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "003f886bc4e2987729d10c1db3424e7f80809f3fc22dbc16c685738887cb37b8" +checksum = "8c80cf55a351448317210f26c434be761bcb25e7b36116ec92f89540b73e2833" dependencies = [ - "smithay-clipboard", + "cranelift-assembler-x64-meta", ] [[package]] -name = "clipboard_x11" -version = "0.4.3" +name = "cranelift-assembler-x64-meta" +version = "0.132.0" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "bd63e33452ffdafd39924c4f05a5dd1e94db646c779c6bd59148a3d95fff5ad4" +checksum = "07937ca8617b340162fe3a4716be885b5847e9b56d6c7a89abbe4d42340fdc91" dependencies = [ - "thiserror 2.0.18", - "x11rb", + "cranelift-srcgen", ] [[package]] -name = "codespan-reporting" -version = "0.12.0" +name = "cranelift-bforest" +version = "0.132.0" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "fe6d2e5af09e8c8ad56c969f2157a3d4238cebc7c55f0a517728c38f7b200f81" +checksum = "88217b08180882436d54c0133274885c590698ae854e352bede1cda041230800" dependencies = [ - "serde", - "termcolor", - "unicode-width 0.2.2", + "cranelift-entity", + "wasmtime-internal-core", ] [[package]] -name = "combine" -version = "4.6.7" +name = "cranelift-bitset" +version = "0.132.0" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "ba5a308b75df32fe02788e748662718f03fde005016435c444eea572398219fd" +checksum = "d5c3cf7ba29fa56e56040848e34835d4e45988b2760ef212413409af95ffd8c1" dependencies = [ - "bytes", - "memchr", + "wasmtime-internal-core", ] [[package]] -name = "concurrent-queue" -version = "2.5.0" +name = "cranelift-codegen" +version = "0.132.0" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "4ca0197aee26d1ae37445ee532fefce43251d24cc7c166799f4d46817f1d3973" +checksum = "ebe1aac2efd4cba2047845fce38a68519935a30e20c8a6294ba7e2f448fe722d" dependencies = [ - "crossbeam-utils", + "bumpalo", + "cranelift-assembler-x64", + "cranelift-bforest", + "cranelift-bitset", + "cranelift-codegen-meta", + "cranelift-codegen-shared", + "cranelift-control", + "cranelift-entity", + "cranelift-isle", + "gimli", + "hashbrown 0.17.1", + "libm", + "log", + "regalloc2", + "rustc-hash", + "serde", + "smallvec", + "target-lexicon", + "wasmtime-internal-core", ] [[package]] -name = "core-foundation" -version = "0.9.4" +name = "cranelift-codegen-meta" +version = "0.132.0" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "91e195e091a93c46f7102ec7818a2aa394e1e1771c3ab4825963fa03e45afb8f" +checksum = "0909eaf9d6f18f5bf802d50608cb4368ac340fbd03cc44f2888d1cfcc3faa64e" dependencies = [ - "core-foundation-sys", - "libc", + "cranelift-assembler-x64-meta", + "cranelift-codegen-shared", + "cranelift-srcgen", + "heck", ] [[package]] -name = "core-foundation" -version = "0.10.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "b2a6cd9ae233e7f62ba4e9353e81a88df7fc8a5987b8d445b4d90c879bd156f6" -dependencies = [ - "core-foundation-sys", - "libc", -] - -[[package]] -name = "core-foundation-sys" -version = "0.8.7" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "773648b94d0e5d620f64f280777445740e61fe701025087ec8b57f45c791888b" - -[[package]] -name = "core-graphics" -version = "0.23.2" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "c07782be35f9e1140080c6b96f0d44b739e2278479f64e02fdab4e32dfd8b081" -dependencies = [ - "bitflags 1.3.2", - "core-foundation 0.9.4", - "core-graphics-types 0.1.3", - "foreign-types", - "libc", -] - -[[package]] -name = "core-graphics-types" -version = "0.1.3" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "45390e6114f68f718cc7a830514a96f903cccd70d02a8f6d9f643ac4ba45afaf" -dependencies = [ - "bitflags 1.3.2", - "core-foundation 0.9.4", - "libc", -] - -[[package]] -name = "core-graphics-types" -version = "0.2.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "3d44a101f213f6c4cdc1853d4b78aef6db6bdfa3468798cc1d9912f4735013eb" -dependencies = [ - "bitflags 2.11.1", - "core-foundation 0.10.1", - "libc", -] - -[[package]] -name = "core_maths" -version = "0.1.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "77745e017f5edba1a9c1d854f6f3a52dac8a12dd5af5d2f54aecf61e43d80d30" -dependencies = [ - "libm", -] - -[[package]] -name = "cosmic-text" -version = "0.15.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "173852283a9a57a3cbe365d86e74dc428a09c50421477d5ad6fe9d9509e37737" -dependencies = [ - "bitflags 2.11.1", - "fontdb", - "harfrust", - "linebender_resource_handle", - "log", - "rangemap", - "rustc-hash 1.1.0", - "self_cell", - "skrifa 0.37.0", - "smol_str 0.2.2", - "swash", - "sys-locale", - "unicode-bidi", - "unicode-linebreak", - "unicode-script", - "unicode-segmentation", -] - -[[package]] -name = "cpufeatures" -version = "0.2.17" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "59ed5838eebb26a2bb2e58f6d5b5316989ae9d08bab10e0e6d103e656d1b0280" -dependencies = [ - "libc", -] - -[[package]] -name = "cranelift-assembler-x64" -version = "0.132.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "8c80cf55a351448317210f26c434be761bcb25e7b36116ec92f89540b73e2833" -dependencies = [ - "cranelift-assembler-x64-meta", -] - -[[package]] -name = "cranelift-assembler-x64-meta" -version = "0.132.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "07937ca8617b340162fe3a4716be885b5847e9b56d6c7a89abbe4d42340fdc91" -dependencies = [ - "cranelift-srcgen", -] - -[[package]] -name = "cranelift-bforest" -version = "0.132.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "88217b08180882436d54c0133274885c590698ae854e352bede1cda041230800" -dependencies = [ - "cranelift-entity", - "wasmtime-internal-core", -] - -[[package]] -name = "cranelift-bitset" -version = "0.132.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "d5c3cf7ba29fa56e56040848e34835d4e45988b2760ef212413409af95ffd8c1" -dependencies = [ - "wasmtime-internal-core", -] - -[[package]] -name = "cranelift-codegen" -version = "0.132.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "ebe1aac2efd4cba2047845fce38a68519935a30e20c8a6294ba7e2f448fe722d" -dependencies = [ - "bumpalo", - "cranelift-assembler-x64", - "cranelift-bforest", - "cranelift-bitset", - "cranelift-codegen-meta", - "cranelift-codegen-shared", - "cranelift-control", - "cranelift-entity", - "cranelift-isle", - "gimli", - "hashbrown 0.17.1", - "libm", - "log", - "regalloc2", - "rustc-hash 2.1.2", - "serde", - "smallvec", - "target-lexicon", - "wasmtime-internal-core", -] - -[[package]] -name = "cranelift-codegen-meta" -version = "0.132.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "0909eaf9d6f18f5bf802d50608cb4368ac340fbd03cc44f2888d1cfcc3faa64e" -dependencies = [ - "cranelift-assembler-x64-meta", - "cranelift-codegen-shared", - "cranelift-srcgen", - "heck", -] - -[[package]] -name = "cranelift-codegen-shared" -version = "0.132.0" +name = "cranelift-codegen-shared" +version = "0.132.0" source = "registry+https://github.com/rust-lang/crates.io-index" checksum = "c95a8da8be283f49cda7d0ef228c94f10d791e517b27b0c7e282dadd2e79ce45" @@ -883,7 +389,7 @@ dependencies = [ "cranelift-native", "libc", "log", - "memmap2 0.2.3", + "memmap2", "region", "target-lexicon", "wasmtime-internal-jit-icache-coherence", @@ -918,31 +424,6 @@ version = "0.132.0" source = "registry+https://github.com/rust-lang/crates.io-index" checksum = "a3ceab9a53f7d362c89841fbaa8e63e44d47c40e91dc96ee6f777fca5d6b323b" -[[package]] -name = "crossbeam-utils" -version = "0.8.21" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "d0a5c400df2834b80a4c3327b3aad3a4c4cd4de0629063962b03235697506a28" - -[[package]] -name = "crunchy" -version = "0.2.4" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "460fbee9c2c2f33933d720630a6a0bac33ba7053db5344fac858d4b8952d77d5" - -[[package]] -name = "cryoglyph" -version = "0.1.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "08bc795bdbccdbd461736fb163930a009da6597b226d6f6fce33e7a8eb6ec519" -dependencies = [ - "cosmic-text", - "etagere", - "lru", - "rustc-hash 2.1.2", - "wgpu", -] - [[package]] name = "crypto-common" version = "0.1.7" @@ -953,21 +434,6 @@ dependencies = [ "typenum", ] -[[package]] -name = "ctor" -version = "0.10.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "83cf0d42651b16c6dfe68685716d18480d18a9c39c62d76e8cf3eb6ed5d8bcbf" -dependencies = [ - "dtor", -] - -[[package]] -name = "cursor-icon" -version = "1.2.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "f27ae1dd37df86211c42e150270f82743308803d90a6f6e6651cd730d5e1732f" - [[package]] name = "darling" version = "0.23.0" @@ -1022,58 +488,6 @@ dependencies = [ "crypto-common", ] -[[package]] -name = "dispatch" -version = "0.2.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "bd0c93bb4b0c6d9b77f4435b0ae98c24d17f1c45b2ff844c6151a07256ca923b" - -[[package]] -name = "dispatch2" -version = "0.3.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "1e0e367e4e7da84520dedcac1901e4da967309406d1e51017ae1abfb97adbd38" -dependencies = [ - "bitflags 2.11.1", - "objc2 0.6.4", -] - -[[package]] -name = "dlib" -version = "0.5.3" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "ab8ecd87370524b461f8557c119c405552c396ed91fc0a8eec68679eab26f94a" -dependencies = [ - "libloading", -] - -[[package]] -name = "document-features" -version = "0.2.12" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "d4b8a88685455ed29a21542a33abd9cb6510b6b129abadabdcef0f4c55bc8f61" -dependencies = [ - "litrs", -] - -[[package]] -name = "downcast-rs" -version = "1.2.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "75b325c5dbd37f80359721ad39aca5a29fb04c89279657cffdda8736d0c0b9d2" - -[[package]] -name = "dpi" -version = "0.1.2" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "d8b14ccef22fc6f5a8f4d7d768562a182c04ce9a3b3157b91390b52ddfdf1a76" - -[[package]] -name = "dtor" -version = "0.8.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "edf234dd1594d6dd434a8fb8cada51ddbbc593e40e4a01556a0b31c62da2775b" - [[package]] name = "dyn-clone" version = "1.0.20" @@ -1107,12 +521,6 @@ dependencies = [ "log", ] -[[package]] -name = "endi" -version = "1.1.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "66b7e2430c6dff6a955451e2cfc438f09cea1965a9d6f87f7e3b90decc014099" - [[package]] name = "enum-ordinalize" version = "4.3.2" @@ -1133,95 +541,12 @@ dependencies = [ "syn", ] -[[package]] -name = "enumflags2" -version = "0.7.12" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "1027f7680c853e056ebcec683615fb6fbbc07dbaa13b4d5d9442b146ded4ecef" -dependencies = [ - "enumflags2_derive", - "serde", -] - -[[package]] -name = "enumflags2_derive" -version = "0.7.12" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "67c78a4d8fdf9953a5c9d458f9efe940fd97a0cab0941c075a813ac594733827" -dependencies = [ - "proc-macro2", - "quote", - "syn", -] - [[package]] name = "equivalent" version = "1.0.2" source = "registry+https://github.com/rust-lang/crates.io-index" checksum = "877a4ace8713b0bcf2a4e7eec82529c029f1d0619886d18145fea96c3ffe5c0f" -[[package]] -name = "errno" -version = "0.3.14" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "39cab71617ae0d63f51a36d69f866391735b51691dbda63cf6f96d042b63efeb" -dependencies = [ - "libc", - "windows-sys 0.61.2", -] - -[[package]] -name = "error-code" -version = "3.3.2" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "dea2df4cf52843e0452895c455a1a2cfbb842a1e7329671acf418fdc53ed4c59" - -[[package]] -name = "etagere" -version = "0.2.15" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "fc89bf99e5dc15954a60f707c1e09d7540e5cd9af85fa75caa0b510bc08c5342" -dependencies = [ - "euclid", - "svg_fmt", -] - -[[package]] -name = "euclid" -version = "0.22.14" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "f1a05365e3b1c6d1650318537c7460c6923f1abdd272ad6842baa2b509957a06" -dependencies = [ - "num-traits", -] - -[[package]] -name = "event-listener" -version = "5.4.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "e13b66accf52311f30a0db42147dadea9850cb48cd070028831ae5f5d4b856ab" -dependencies = [ - "concurrent-queue", - "parking", - "pin-project-lite", -] - -[[package]] -name = "event-listener-strategy" -version = "0.5.4" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "8be9f3dfaaffdae2972880079a491a1a8bb7cbed0b8dd7a347f668b4150a3b93" -dependencies = [ - "event-listener", - "pin-project-lite", -] - -[[package]] -name = "fastrand" -version = "2.4.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "9f1f227452a390804cdb637b74a86990f2a7d7ba4b7d5693aac9b4dd6defd8d6" - [[package]] name = "find-msvc-tools" version = "0.1.9" @@ -1240,12 +565,6 @@ version = "1.0.7" source = "registry+https://github.com/rust-lang/crates.io-index" checksum = "3f9eec918d3f24069decb9af1554cad7c880e2da24a9afd88aca000531ab82c1" -[[package]] -name = "foldhash" -version = "0.1.5" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "d9c4f5dac5e15c24eb999c26181a6ca40b39fe946cbe4c263c7209467bc83af2" - [[package]] name = "foldhash" version = "0.2.0" @@ -1253,2625 +572,664 @@ source = "registry+https://github.com/rust-lang/crates.io-index" checksum = "77ce24cb58228fbb8aa041425bb1050850ac19177686ea6e0f41a70416f56fdb" [[package]] -name = "font-types" -version = "0.10.1" +name = "futures-core" +version = "0.3.32" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "39a654f404bbcbd48ea58c617c2993ee91d1cb63727a37bf2323a4edeed1b8c5" -dependencies = [ - "bytemuck", -] +checksum = "7e3450815272ef58cec6d564423f6e755e25379b217b0bc688e295ba24df6b1d" [[package]] -name = "font-types" -version = "0.11.3" +name = "futures-task" +version = "0.3.32" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "5b38ad915f6dadd993ced50848a8291a543bd41ca62bc10740d5e64e2ab4cfd7" -dependencies = [ - "bytemuck", -] +checksum = "037711b3d59c33004d3856fbdc83b99d4ff37a24768fa1be9ce3538a1cde4393" [[package]] -name = "fontconfig-parser" -version = "0.5.8" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "bbc773e24e02d4ddd8395fd30dc147524273a83e54e0f312d986ea30de5f5646" -dependencies = [ - "roxmltree", -] - -[[package]] -name = "fontdb" -version = "0.23.0" +name = "futures-util" +version = "0.3.32" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "457e789b3d1202543297a350643cf459f836cade38934e7a4cf6a39e7cde2905" +checksum = "389ca41296e6190b48053de0321d02a77f32f8a5d2461dd38762c0593805c6d6" dependencies = [ - "fontconfig-parser", - "log", - "memmap2 0.9.10", - "slotmap", - "tinyvec", - "ttf-parser", + "futures-core", + "futures-task", + "pin-project-lite", + "slab", ] [[package]] -name = "foreign-types" -version = "0.5.0" +name = "generic-array" +version = "0.14.7" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "d737d9aa519fb7b749cbc3b962edcf310a8dd1f4b67c91c4f83975dbdd17d965" +checksum = "85649ca51fd72272d7821adaf274ad91c288277713d9c18820d8499a7ff69e9a" dependencies = [ - "foreign-types-macros", - "foreign-types-shared", + "typenum", + "version_check", ] [[package]] -name = "foreign-types-macros" -version = "0.2.3" +name = "gimli" +version = "0.33.0" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "1a5c6c585bc94aaf2c7b51dd4c2ba22680844aba4c687be581871a6f518c5742" +checksum = "0bf7f043f89559805f8c7cacc432749b2fa0d0a0a9ee46ce47164ed5ba7f126c" dependencies = [ - "proc-macro2", - "quote", - "syn", + "fnv", + "hashbrown 0.16.1", + "indexmap 2.14.0", + "stable_deref_trait", ] [[package]] -name = "foreign-types-shared" -version = "0.3.1" +name = "hashbrown" +version = "0.12.3" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "aa9a19cbb55df58761df49b23516a86d432839add4af60fc256da840f66ed35b" +checksum = "8a9ee70c43aaf417c914396645a0fa852624801b24ebb7ae78fe8272889ac888" [[package]] -name = "futures" -version = "0.3.32" +name = "hashbrown" +version = "0.16.1" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "8b147ee9d1f6d097cef9ce628cd2ee62288d963e16fb287bd9286455b241382d" -dependencies = [ - "futures-channel", - "futures-core", - "futures-executor", - "futures-io", - "futures-sink", - "futures-task", - "futures-util", -] +checksum = "841d1cc9bed7f9236f321df977030373f4a4163ae1a7dbfe1a51a2c1a51d9100" [[package]] -name = "futures-channel" -version = "0.3.32" +name = "hashbrown" +version = "0.17.1" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "07bbe89c50d7a535e539b8c17bc0b49bdb77747034daa8087407d655f3f7cc1d" +checksum = "ed5909b6e89a2db4456e54cd5f673791d7eca6732202bbf2a9cc504fe2f9b84a" dependencies = [ - "futures-core", - "futures-sink", + "foldhash", ] [[package]] -name = "futures-core" -version = "0.3.32" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "7e3450815272ef58cec6d564423f6e755e25379b217b0bc688e295ba24df6b1d" - -[[package]] -name = "futures-executor" -version = "0.3.32" +name = "heck" +version = "0.5.0" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "baf29c38818342a3b26b5b923639e7b1f4a61fc5e76102d4b1981c6dc7a7579d" -dependencies = [ - "futures-core", - "futures-task", - "futures-util", -] +checksum = "2304e00983f87ffb38b55b444b5e3b60a884b5d30c0fca7d82fe33449bbe55ea" [[package]] -name = "futures-io" -version = "0.3.32" +name = "hex" +version = "0.4.3" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "cecba35d7ad927e23624b22ad55235f2239cfa44fd10428eecbeba6d6a717718" +checksum = "7f24254aa9a54b5c858eaee2f5bccdb46aaf0e486a595ed5fd8f86ba55232a70" [[package]] -name = "futures-lite" -version = "2.6.1" +name = "iana-time-zone" +version = "0.1.65" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "f78e10609fe0e0b3f4157ffab1876319b5b0db102a2c60dc4626306dc46b44ad" +checksum = "e31bc9ad994ba00e440a8aa5c9ef0ec67d5cb5e5cb0cc7f8b744a35b389cc470" dependencies = [ - "fastrand", - "futures-core", - "futures-io", - "parking", - "pin-project-lite", + "android_system_properties", + "core-foundation-sys", + "iana-time-zone-haiku", + "js-sys", + "log", + "wasm-bindgen", + "windows-core", ] [[package]] -name = "futures-macro" -version = "0.3.32" +name = "iana-time-zone-haiku" +version = "0.1.2" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "e835b70203e41293343137df5c0664546da5745f82ec9b84d40be8336958447b" +checksum = "f31827a206f56af32e590ba56d5d2d085f558508192593743f16b2306495269f" dependencies = [ - "proc-macro2", - "quote", - "syn", + "cc", ] [[package]] -name = "futures-sink" -version = "0.3.32" +name = "ident_case" +version = "1.0.1" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "c39754e157331b013978ec91992bde1ac089843443c49cbc7f46150b0fad0893" +checksum = "b9e0384b61958566e926dc50660321d12159025e767c18e043daf26b70104c39" [[package]] -name = "futures-task" -version = "0.3.32" +name = "indexmap" +version = "1.9.3" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "037711b3d59c33004d3856fbdc83b99d4ff37a24768fa1be9ce3538a1cde4393" +checksum = "bd070e393353796e801d209ad339e89596eb4c8d430d18ede6a1cced8fafbd99" +dependencies = [ + "autocfg", + "hashbrown 0.12.3", + "serde", +] [[package]] -name = "futures-util" -version = "0.3.32" +name = "indexmap" +version = "2.14.0" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "389ca41296e6190b48053de0321d02a77f32f8a5d2461dd38762c0593805c6d6" +checksum = "d466e9454f08e4a911e14806c24e16fba1b4c121d1ea474396f396069cf949d9" dependencies = [ - "futures-channel", - "futures-core", - "futures-io", - "futures-macro", - "futures-sink", - "futures-task", - "memchr", - "pin-project-lite", - "slab", + "equivalent", + "hashbrown 0.17.1", + "serde", + "serde_core", ] [[package]] -name = "generic-array" -version = "0.14.7" +name = "itertools" +version = "0.14.0" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "85649ca51fd72272d7821adaf274ad91c288277713d9c18820d8499a7ff69e9a" +checksum = "2b192c782037fadd9cfa75548310488aabdbf3d2da73885b31bd0abd03351285" dependencies = [ - "typenum", - "version_check", + "either", ] [[package]] -name = "gethostname" -version = "1.1.0" +name = "itoa" +version = "1.0.18" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "1bd49230192a3797a9a4d6abe9b3eed6f7fa4c8a8a4947977c6f80025f92cbd8" -dependencies = [ - "rustix 1.1.4", - "windows-link", -] +checksum = "8f42a60cbdf9a97f5d2305f08a87dc4e09308d1276d28c869c684d7777685682" [[package]] -name = "getrandom" -version = "0.3.4" +name = "js-sys" +version = "0.3.99" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "899def5c37c4fd7b2664648c28120ecec138e4d395b459e5ca34f9cce2dd77fd" +checksum = "142bc4740e452c1e57ade0cbc129f139c9093e354346f0872ef985f4f5cf5f11" dependencies = [ "cfg-if", - "libc", - "r-efi 5.3.0", - "wasip2", + "futures-util", + "once_cell", + "wasm-bindgen", ] [[package]] -name = "getrandom" -version = "0.4.3" +name = "keccak" +version = "0.1.6" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "300e883d756b2e4ec94e02791f39b04b522276138852cfc41d9fb7e904106099" +checksum = "cb26cec98cce3a3d96cbb7bced3c4b16e3d13f27ec56dbd62cbc8f39cfb9d653" dependencies = [ - "cfg-if", - "libc", - "r-efi 6.0.0", + "cpufeatures", ] [[package]] -name = "gimli" -version = "0.33.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "0bf7f043f89559805f8c7cacc432749b2fa0d0a0a9ee46ce47164ed5ba7f126c" +name = "klcompile" +version = "0.1.0" dependencies = [ - "fnv", - "hashbrown 0.16.1", - "indexmap 2.14.0", - "stable_deref_trait", + "shen-rust", ] [[package]] -name = "gl_generator" -version = "0.14.0" +name = "lalrpop" +version = "0.22.2" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "1a95dfc23a2b4a9a2f5ab41d194f8bfda3cabec42af4e39f08c339eb2a0c124d" +checksum = "ba4ebbd48ce411c1d10fb35185f5a51a7bfa3d8b24b4e330d30c9e3a34129501" dependencies = [ - "khronos_api", - "log", - "xml-rs", + "ascii-canvas", + "bit-set", + "ena", + "itertools", + "lalrpop-util", + "petgraph", + "pico-args", + "regex", + "regex-syntax", + "sha3", + "string_cache", + "term", + "unicode-xid", + "walkdir", ] [[package]] -name = "glam" -version = "0.25.0" +name = "lalrpop-util" +version = "0.22.2" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "151665d9be52f9bb40fc7966565d39666f2d1e69233571b71b87791c7e0528b3" +checksum = "b5baa5e9ff84f1aefd264e6869907646538a52147a755d494517a8007fb48733" +dependencies = [ + "regex-automata", + "rustversion", +] [[package]] -name = "glow" -version = "0.16.0" +name = "libc" +version = "0.2.186" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "c5e5ea60d70410161c8bf5da3fdfeaa1c72ed2c15f8bbb9d19fe3a4fad085f08" -dependencies = [ - "js-sys", - "slotmap", - "wasm-bindgen", - "web-sys", -] +checksum = "68ab91017fe16c622486840e4c83c9a37afeff978bd239b5293d61ece587de66" [[package]] -name = "glutin_wgl_sys" -version = "0.6.1" +name = "libm" +version = "0.2.16" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "2c4ee00b289aba7a9e5306d57c2d05499b2e5dc427f84ac708bd2c090212cf3e" -dependencies = [ - "gl_generator", -] +checksum = "b6d2cec3eae94f9f509c767b45932f1ada8350c4bdb85af2fcab4a3c14807981" [[package]] -name = "gpu-alloc" -version = "0.6.0" +name = "linked-hash-map" +version = "0.5.6" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "fbcd2dba93594b227a1f57ee09b8b9da8892c34d55aa332e034a228d0fe6a171" +checksum = "0717cef1bc8b636c6e1c1bbdefc09e6322da8a9321966e8928ef80d20f7f770f" dependencies = [ - "bitflags 2.11.1", - "gpu-alloc-types", + "serde", ] [[package]] -name = "gpu-alloc-types" -version = "0.3.0" +name = "linked_hash_set" +version = "0.1.6" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "98ff03b468aa837d70984d55f5d3f846f6ec31fe34bbb97c4f85219caeee1ca4" +checksum = "984fb35d06508d1e69fc91050cceba9c0b748f983e6739fa2c7a9237154c52c8" dependencies = [ - "bitflags 2.11.1", + "linked-hash-map", ] [[package]] -name = "gpu-allocator" -version = "0.27.0" +name = "lock_api" +version = "0.4.14" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "c151a2a5ef800297b4e79efa4f4bec035c5f51d5ae587287c9b952bdf734cacd" +checksum = "224399e74b87b5f3557511d98dff8b14089b3dadafcab6bb93eab67d3aace965" dependencies = [ - "log", - "presser", - "thiserror 1.0.69", - "windows 0.58.0", + "scopeguard", ] [[package]] -name = "gpu-descriptor" -version = "0.3.2" +name = "log" +version = "0.4.30" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "b89c83349105e3732062a895becfc71a8f921bb71ecbbdd8ff99263e3b53a0ca" -dependencies = [ - "bitflags 2.11.1", - "gpu-descriptor-types", - "hashbrown 0.15.5", -] +checksum = "616ec5685824bcc94416c6d4a7a446eea774a31efd7062c8480ba6fd06d7a6e5" [[package]] -name = "gpu-descriptor-types" -version = "0.2.0" +name = "logos" +version = "0.16.1" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "fdf242682df893b86f33a73828fb09ca4b2d3bb6cc95249707fc684d27484b91" +checksum = "eb2c55a318a87600ea870ff8c2012148b44bf18b74fad48d0f835c38c7d07c5f" dependencies = [ - "bitflags 2.11.1", + "logos-derive", ] [[package]] -name = "guillotiere" -version = "0.6.2" +name = "logos-codegen" +version = "0.16.1" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "b62d5865c036cb1393e23c50693df631d3f5d7bcca4c04fe4cc0fd592e74a782" +checksum = "58b3ffaa284e1350d017a57d04ada118c4583cf260c8fb01e0fe28a2e9cf8970" dependencies = [ - "euclid", - "svg_fmt", + "fnv", + "proc-macro2", + "quote", + "regex-automata", + "regex-syntax", + "syn", ] [[package]] -name = "half" -version = "2.7.1" +name = "logos-derive" +version = "0.16.1" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "6ea2d84b969582b4b1864a92dc5d27cd2b77b622a8d79306834f1be5ba20d84b" +checksum = "52d3a9855747c17eaf4383823f135220716ab49bea5fbea7dd42cc9a92f8aa31" dependencies = [ - "cfg-if", - "crunchy", - "num-traits", - "zerocopy", + "logos-codegen", ] [[package]] -name = "harfrust" -version = "0.3.2" +name = "mach2" +version = "0.4.3" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "92c020db12c71d8a12a3fe7607873cade3a01a6287e29d540c8723276221b9d8" +checksum = "d640282b302c0bb0a2a8e0233ead9035e3bed871f0b7e81fe4a1ec829765db44" dependencies = [ - "bitflags 2.11.1", - "bytemuck", - "core_maths", - "read-fonts 0.35.0", - "smallvec", + "libc", ] [[package]] -name = "hashbrown" -version = "0.12.3" +name = "memchr" +version = "2.8.1" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "8a9ee70c43aaf417c914396645a0fa852624801b24ebb7ae78fe8272889ac888" +checksum = "6b947ae49db0d222b1dbc6b113ce7248a3fc3a6ca21b696717bfc000ba4484d8" [[package]] -name = "hashbrown" -version = "0.15.5" +name = "memmap2" +version = "0.2.3" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "9229cfe53dfd69f0609a49f65461bd93001ea1ef889cd5529dd176593f5338a1" +checksum = "723e3ebdcdc5c023db1df315364573789f8857c11b631a2fdfad7c00f5c046b4" dependencies = [ - "foldhash 0.1.5", + "libc", ] [[package]] -name = "hashbrown" -version = "0.16.1" +name = "miette" +version = "7.6.0" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "841d1cc9bed7f9236f321df977030373f4a4163ae1a7dbfe1a51a2c1a51d9100" +checksum = "5f98efec8807c63c752b5bd61f862c165c115b0a35685bdcfd9238c7aeb592b7" dependencies = [ - "foldhash 0.2.0", + "cfg-if", + "miette-derive", + "serde", + "unicode-width 0.1.14", ] [[package]] -name = "hashbrown" -version = "0.17.1" +name = "miette-derive" +version = "7.6.0" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "ed5909b6e89a2db4456e54cd5f673791d7eca6732202bbf2a9cc504fe2f9b84a" +checksum = "db5b29714e950dbb20d5e6f74f9dcec4edbcc1067bb7f8ed198c097b8c1a818b" dependencies = [ - "foldhash 0.2.0", + "proc-macro2", + "quote", + "syn", ] [[package]] -name = "heck" -version = "0.5.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "2304e00983f87ffb38b55b444b5e3b60a884b5d30c0fca7d82fe33449bbe55ea" - -[[package]] -name = "hermit-abi" -version = "0.5.2" +name = "new_debug_unreachable" +version = "1.0.6" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "fc0fef456e4baa96da950455cd02c081ca953b141298e41db3fc7e36b1da849c" +checksum = "650eef8c711430f1a879fdd01d4745a7deea475becfb90269c06775983bbf086" [[package]] -name = "hex" -version = "0.4.3" +name = "nonempty" +version = "0.12.0" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "7f24254aa9a54b5c858eaee2f5bccdb46aaf0e486a595ed5fd8f86ba55232a70" +checksum = "9737e026353e5cd0736f98eddae28665118eb6f6600902a7f50db585621fecb6" +dependencies = [ + "serde", +] [[package]] -name = "hexf-parse" -version = "0.2.1" +name = "num-conv" +version = "0.2.2" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "dfa686283ad6dd069f105e5ab091b04c62850d3e4cf5d67debad1933f55023df" +checksum = "521739c6d2bac4aa25192232afe6841231376b2b26d4d9fae5ecf8ca5772e441" [[package]] -name = "iana-time-zone" -version = "0.1.65" +name = "num-traits" +version = "0.2.19" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "e31bc9ad994ba00e440a8aa5c9ef0ec67d5cb5e5cb0cc7f8b744a35b389cc470" +checksum = "071dfc062690e90b734c0b2273ce72ad0ffa95f0c74596bc250dcfd960262841" dependencies = [ - "android_system_properties", - "core-foundation-sys", - "iana-time-zone-haiku", - "js-sys", - "log", - "wasm-bindgen", - "windows-core 0.62.2", + "autocfg", ] [[package]] -name = "iana-time-zone-haiku" -version = "0.1.2" +name = "object" +version = "0.37.3" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "f31827a206f56af32e590ba56d5d2d085f558508192593743f16b2306495269f" +checksum = "ff76201f031d8863c38aa7f905eca4f53abbfa15f609db4277d44cd8938f33fe" dependencies = [ - "cc", + "memchr", ] [[package]] -name = "iced" -version = "0.14.0" +name = "once_cell" +version = "1.21.4" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "000e01026c93ba643f8357a3db3ada0e6555265a377f6f9291c472f6dd701fb3" -dependencies = [ - "iced_core", - "iced_debug", - "iced_futures", - "iced_renderer", - "iced_runtime", - "iced_widget", - "iced_winit", - "thiserror 2.0.18", -] +checksum = "9f7c3e4beb33f85d45ae3e3a1792185706c8e16d043238c593331cc7cd313b50" [[package]] -name = "iced_core" -version = "0.14.0" +name = "parking_lot" +version = "0.12.5" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "91ab1937d699403e7e69252ae743a902bcee9f4ab2052cc4c9a46fcf34729d85" +checksum = "93857453250e3077bd71ff98b6a65ea6621a19bb0f559a85248955ac12c45a1a" dependencies = [ - "bitflags 2.11.1", - "bytes", - "glam", - "lilt", - "log", - "num-traits", - "rustc-hash 2.1.2", - "smol_str 0.2.2", - "thiserror 2.0.18", - "web-time", + "lock_api", + "parking_lot_core", ] [[package]] -name = "iced_debug" -version = "0.14.0" +name = "parking_lot_core" +version = "0.9.12" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "25035ab0215a620e53f4103e36fc4e59a1fb2817e4bfc38a30ad27b4202ea0be" +checksum = "2621685985a2ebf1c516881c026032ac7deafcda1a2c9b7850dc81e3dfcb64c1" dependencies = [ - "iced_core", - "iced_futures", - "log", + "cfg-if", + "libc", + "redox_syscall", + "smallvec", + "windows-link", ] [[package]] -name = "iced_futures" -version = "0.14.0" +name = "petgraph" +version = "0.7.1" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "8c0c85ccad42dfbec7293c36c018af0ea0dbcc52d137a4a9a0b0f6822a3fdf0a" +checksum = "3672b37090dbd86368a4145bc067582552b29c27377cad4e0a306c97f9bd7772" dependencies = [ - "futures", - "iced_core", - "log", - "rustc-hash 2.1.2", - "wasm-bindgen-futures", - "wasmtimer", + "fixedbitset", + "indexmap 2.14.0", ] [[package]] -name = "iced_graphics" -version = "0.14.0" +name = "phf_shared" +version = "0.11.3" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "234ca1c2cec4155055f68fa5fad1b5242c496ac8238d80a259bca382fb44a102" +checksum = "67eabc2ef2a60eb7faa00097bd1ffdb5bd28e62bf39990626a582201b7a754e5" dependencies = [ - "bitflags 2.11.1", - "bytemuck", - "cosmic-text", - "half", - "iced_core", - "iced_futures", - "log", - "raw-window-handle", - "rustc-hash 2.1.2", - "thiserror 2.0.18", - "unicode-segmentation", + "siphasher", ] [[package]] -name = "iced_program" -version = "0.14.0" +name = "pico-args" +version = "0.5.0" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "6dfafec2947cda688d8eb00dac337ba11aa60f9ef6335aed343e189d26e4a673" -dependencies = [ - "iced_graphics", - "iced_runtime", -] +checksum = "5be167a7af36ee22fe3115051bc51f6e6c7054c9348e28deb4f49bd6f705a315" [[package]] -name = "iced_renderer" -version = "0.14.0" +name = "pin-project-lite" +version = "0.2.17" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "250cc0802408e8c077986ec56c7d07c65f423ee658a4b9fd795a1f2aae5dac05" -dependencies = [ - "iced_graphics", - "iced_tiny_skia", - "iced_wgpu", - "log", - "thiserror 2.0.18", -] +checksum = "a89322df9ebe1c1578d689c92318e070967d1042b512afbe49518723f4e6d5cd" [[package]] -name = "iced_runtime" -version = "0.14.0" +name = "powerfmt" +version = "0.2.0" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "d1889b819ce4c06674183242e336c8d49465665441396914dc07cc86f44fa8d4" -dependencies = [ - "bytes", - "iced_core", - "iced_futures", - "raw-window-handle", - "thiserror 2.0.18", -] +checksum = "439ee305def115ba05938db6eb1644ff94165c5ab5e9420d1c1bcedbba909391" [[package]] -name = "iced_tiny_skia" -version = "0.14.0" +name = "precomputed-hash" +version = "0.1.1" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "fe0acf8b75a3bc914aff5f2329fdffc1b36eeaea29dda0e4bd232f1c62e9cc3d" -dependencies = [ - "bytemuck", - "cosmic-text", - "iced_debug", - "iced_graphics", - "kurbo", - "log", - "rustc-hash 2.1.2", - "softbuffer", - "tiny-skia", -] +checksum = "925383efa346730478fb4838dbe9137d2a47675ad789c546d150a6e1dd4ab31c" [[package]] -name = "iced_wgpu" -version = "0.14.0" +name = "pretty" +version = "0.12.5" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "ff144a999b0ca0f8a10257934500060240825c42e950ec0ebee9c8ae30561c13" +checksum = "0d22152487193190344590e4f30e219cf3fe140d9e7a3fdb683d82aa2c5f4156" dependencies = [ - "bitflags 2.11.1", - "bytemuck", - "cryoglyph", - "futures", - "glam", - "guillotiere", - "iced_debug", - "iced_graphics", - "log", - "rustc-hash 2.1.2", - "thiserror 2.0.18", - "wgpu", + "arrayvec", + "typed-arena", + "unicode-width 0.2.2", ] [[package]] -name = "iced_widget" -version = "0.14.2" +name = "proc-macro2" +version = "1.0.106" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "b1596afa0d3109c2618e8bc12bae6c11d3064df8f95c42dfce570397dbe957ab" +checksum = "8fd00f0bb2e90d81d1044c2b32617f68fcb9fa3bb7640c23e9c748e53fb30934" dependencies = [ - "iced_renderer", - "log", - "num-traits", - "rustc-hash 2.1.2", - "thiserror 2.0.18", - "unicode-segmentation", + "unicode-ident", ] [[package]] -name = "iced_winit" -version = "0.14.0" +name = "psm" +version = "0.1.31" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "8b7dbedc47562d1de3b9707d939f678b88c382004b7ab5a18f7a7dd723162d75" +checksum = "645dbe486e346d9b5de3ef16ede18c26e6c70ad97418f4874b8b1889d6e761ea" dependencies = [ - "iced_debug", - "iced_program", - "log", - "mundy", - "rustc-hash 2.1.2", - "thiserror 2.0.18", - "tracing", - "wasm-bindgen-futures", - "web-sys", - "window_clipboard", - "winit", + "ar_archive_writer", + "cc", ] [[package]] -name = "ident_case" -version = "1.0.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "b9e0384b61958566e926dc50660321d12159025e767c18e043daf26b70104c39" - -[[package]] -name = "indexmap" -version = "1.9.3" +name = "quote" +version = "1.0.45" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "bd070e393353796e801d209ad339e89596eb4c8d430d18ede6a1cced8fafbd99" +checksum = "41f2619966050689382d2b44f664f4bc593e129785a36d6ee376ddf37259b924" dependencies = [ - "autocfg", - "hashbrown 0.12.3", - "serde", + "proc-macro2", ] [[package]] -name = "indexmap" -version = "2.14.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "d466e9454f08e4a911e14806c24e16fba1b4c121d1ea474396f396069cf949d9" +name = "ratatoskr-build" +version = "0.1.0" dependencies = [ - "equivalent", - "hashbrown 0.17.1", - "serde", - "serde_core", + "klcompile", ] [[package]] -name = "itertools" -version = "0.14.0" +name = "redox_syscall" +version = "0.5.18" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "2b192c782037fadd9cfa75548310488aabdbf3d2da73885b31bd0abd03351285" +checksum = "ed2bf2547551a7053d6fdfafda3f938979645c44812fbfcda098faae3f1a362d" dependencies = [ - "either", + "bitflags 2.11.1", ] [[package]] -name = "itoa" -version = "1.0.18" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "8f42a60cbdf9a97f5d2305f08a87dc4e09308d1276d28c869c684d7777685682" - -[[package]] -name = "jni" -version = "0.22.4" +name = "ref-cast" +version = "1.0.25" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "5efd9a482cf3a427f00d6b35f14332adc7902ce91efb778580e180ff90fa3498" +checksum = "f354300ae66f76f1c85c5f84693f0ce81d747e2c3f21a45fef496d89c960bf7d" dependencies = [ - "cfg-if", - "combine", - "jni-macros", - "jni-sys 0.4.1", - "log", - "simd_cesu8", - "thiserror 2.0.18", - "walkdir", - "windows-link", + "ref-cast-impl", ] [[package]] -name = "jni-macros" -version = "0.22.4" +name = "ref-cast-impl" +version = "1.0.25" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "a00109accc170f0bdb141fed3e393c565b6f5e072365c3bd58f5b062591560a3" +checksum = "b7186006dcb21920990093f30e3dea63b7d6e977bf1256be20c3563a5db070da" dependencies = [ "proc-macro2", "quote", - "rustc_version", - "simd_cesu8", "syn", ] [[package]] -name = "jni-sys" -version = "0.3.1" +name = "regalloc2" +version = "0.15.1" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "41a652e1f9b6e0275df1f15b32661cf0d4b78d4d87ddec5e0c3c20f097433258" +checksum = "de2c52737737f8609e94f975dee22854a2d5c125772d4b1cf292120f4d45c186" dependencies = [ - "jni-sys 0.4.1", + "allocator-api2", + "bumpalo", + "hashbrown 0.17.1", + "log", + "rustc-hash", + "smallvec", ] [[package]] -name = "jni-sys" -version = "0.4.1" +name = "regex" +version = "1.12.3" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "c6377a88cb3910bee9b0fa88d4f42e1d2da8e79915598f65fb0c7ee14c878af2" +checksum = "e10754a14b9137dd7b1e3e5b0493cc9171fdd105e0ab477f51b72e7f3ac0e276" dependencies = [ - "jni-sys-macros", + "aho-corasick", + "memchr", + "regex-automata", + "regex-syntax", ] [[package]] -name = "jni-sys-macros" -version = "0.4.1" +name = "regex-automata" +version = "0.4.14" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "38c0b942f458fe50cdac086d2f946512305e5631e720728f2a61aabcd47a6264" +checksum = "6e1dd4122fc1595e8162618945476892eefca7b88c52820e74af6262213cae8f" dependencies = [ - "quote", - "syn", + "aho-corasick", + "memchr", + "regex-syntax", ] [[package]] -name = "jobserver" -version = "0.1.34" +name = "regex-syntax" +version = "0.8.10" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "9afb3de4395d6b3e67a780b6de64b51c978ecf11cb9a462c66be7d4ca9039d33" -dependencies = [ - "getrandom 0.3.4", - "libc", -] +checksum = "dc897dd8d9e8bd1ed8cdad82b5966c3e0ecae09fb1907d58efaa013543185d0a" [[package]] -name = "js-sys" -version = "0.3.99" +name = "region" +version = "3.0.2" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "142bc4740e452c1e57ade0cbc129f139c9093e354346f0872ef985f4f5cf5f11" +checksum = "e6b6ebd13bc009aef9cd476c1310d49ac354d36e240cf1bd753290f3dc7199a7" dependencies = [ - "cfg-if", - "futures-util", - "once_cell", - "wasm-bindgen", + "bitflags 1.3.2", + "libc", + "mach2", + "windows-sys 0.52.0", ] [[package]] -name = "keccak" -version = "0.1.6" +name = "rustc-hash" +version = "2.1.2" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "cb26cec98cce3a3d96cbb7bced3c4b16e3d13f27ec56dbd62cbc8f39cfb9d653" -dependencies = [ - "cpufeatures", -] +checksum = "94300abf3f1ae2e2b8ffb7b58043de3d399c73fa6f4b73826402a5c457614dbe" [[package]] -name = "khronos-egl" -version = "6.0.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "6aae1df220ece3c0ada96b8153459b67eebe9ae9212258bb0134ae60416fdf76" -dependencies = [ - "libc", - "libloading", - "pkg-config", -] - -[[package]] -name = "khronos_api" -version = "3.1.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "e2db585e1d738fc771bf08a151420d3ed193d9d895a36df7f6f8a9456b911ddc" - -[[package]] -name = "klcompile" -version = "0.1.0" -dependencies = [ - "shen-rust", -] - -[[package]] -name = "kurbo" -version = "0.10.4" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "1618d4ebd923e97d67e7cd363d80aef35fe961005cbbbb3d2dad8bdd1bc63440" -dependencies = [ - "arrayvec 0.7.7", - "smallvec", -] - -[[package]] -name = "lalrpop" -version = "0.22.2" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "ba4ebbd48ce411c1d10fb35185f5a51a7bfa3d8b24b4e330d30c9e3a34129501" -dependencies = [ - "ascii-canvas", - "bit-set", - "ena", - "itertools", - "lalrpop-util", - "petgraph", - "pico-args", - "regex", - "regex-syntax", - "sha3", - "string_cache", - "term", - "unicode-xid", - "walkdir", -] - -[[package]] -name = "lalrpop-util" -version = "0.22.2" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "b5baa5e9ff84f1aefd264e6869907646538a52147a755d494517a8007fb48733" -dependencies = [ - "regex-automata", - "rustversion", -] - -[[package]] -name = "libc" -version = "0.2.186" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "68ab91017fe16c622486840e4c83c9a37afeff978bd239b5293d61ece587de66" - -[[package]] -name = "libloading" -version = "0.8.9" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "d7c4b02199fee7c5d21a5ae7d8cfa79a6ef5bb2fc834d6e9058e89c825efdc55" -dependencies = [ - "cfg-if", - "windows-link", -] - -[[package]] -name = "libm" -version = "0.2.16" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "b6d2cec3eae94f9f509c767b45932f1ada8350c4bdb85af2fcab4a3c14807981" - -[[package]] -name = "libredox" -version = "0.1.17" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "f02ab6bace2054fb888a3c16f990117b579d14a3088e472d63c6011fa185c9d3" -dependencies = [ - "bitflags 2.11.1", - "libc", - "plain", - "redox_syscall 0.8.1", -] - -[[package]] -name = "lilt" -version = "0.8.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "f67562e5eff6b20553fa9be1c503356768420994e28f67e3eafe6f41910e57ad" -dependencies = [ - "web-time", -] - -[[package]] -name = "linebender_resource_handle" -version = "0.1.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "d4a5ff6bcca6c4867b1c4fd4ef63e4db7436ef363e0ad7531d1558856bae64f4" - -[[package]] -name = "linked-hash-map" -version = "0.5.6" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "0717cef1bc8b636c6e1c1bbdefc09e6322da8a9321966e8928ef80d20f7f770f" -dependencies = [ - "serde", -] - -[[package]] -name = "linked_hash_set" -version = "0.1.6" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "984fb35d06508d1e69fc91050cceba9c0b748f983e6739fa2c7a9237154c52c8" -dependencies = [ - "linked-hash-map", -] - -[[package]] -name = "linux-raw-sys" -version = "0.4.15" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "d26c52dbd32dccf2d10cac7725f8eae5296885fb5703b261f7d0a0739ec807ab" - -[[package]] -name = "linux-raw-sys" -version = "0.12.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "32a66949e030da00e8c7d4434b251670a91556f4144941d37452769c25d58a53" - -[[package]] -name = "litrs" -version = "1.0.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "11d3d7f243d5c5a8b9bb5d6dd2b1602c0cb0b9db1621bafc7ed66e35ff9fe092" - -[[package]] -name = "lock_api" -version = "0.4.14" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "224399e74b87b5f3557511d98dff8b14089b3dadafcab6bb93eab67d3aace965" -dependencies = [ - "scopeguard", -] - -[[package]] -name = "log" -version = "0.4.30" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "616ec5685824bcc94416c6d4a7a446eea774a31efd7062c8480ba6fd06d7a6e5" - -[[package]] -name = "logos" -version = "0.16.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "eb2c55a318a87600ea870ff8c2012148b44bf18b74fad48d0f835c38c7d07c5f" -dependencies = [ - "logos-derive", -] - -[[package]] -name = "logos-codegen" -version = "0.16.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "58b3ffaa284e1350d017a57d04ada118c4583cf260c8fb01e0fe28a2e9cf8970" -dependencies = [ - "fnv", - "proc-macro2", - "quote", - "regex-automata", - "regex-syntax", - "syn", -] - -[[package]] -name = "logos-derive" -version = "0.16.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "52d3a9855747c17eaf4383823f135220716ab49bea5fbea7dd42cc9a92f8aa31" -dependencies = [ - "logos-codegen", -] - -[[package]] -name = "lru" -version = "0.16.4" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "7f66e8d5d03f609abc3a39e6f08e4164ebf1447a732906d39eb9b99b7919ef39" - -[[package]] -name = "mach2" -version = "0.4.3" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "d640282b302c0bb0a2a8e0233ead9035e3bed871f0b7e81fe4a1ec829765db44" -dependencies = [ - "libc", -] - -[[package]] -name = "malloc_buf" -version = "0.0.6" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "62bb907fe88d54d8d9ce32a3cceab4218ed2f6b7d35617cafe9adf84e43919cb" -dependencies = [ - "libc", -] - -[[package]] -name = "memchr" -version = "2.8.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "6b947ae49db0d222b1dbc6b113ce7248a3fc3a6ca21b696717bfc000ba4484d8" - -[[package]] -name = "memmap2" -version = "0.2.3" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "723e3ebdcdc5c023db1df315364573789f8857c11b631a2fdfad7c00f5c046b4" -dependencies = [ - "libc", -] - -[[package]] -name = "memmap2" -version = "0.9.10" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "714098028fe011992e1c3962653c96b2d578c4b4bce9036e15ff220319b1e0e3" -dependencies = [ - "libc", -] - -[[package]] -name = "memoffset" -version = "0.9.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "488016bfae457b036d996092f6cb448677611ce4449e970ceaf42695203f218a" -dependencies = [ - "autocfg", -] - -[[package]] -name = "metal" -version = "0.32.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "00c15a6f673ff72ddcc22394663290f870fb224c1bfce55734a75c414150e605" -dependencies = [ - "bitflags 2.11.1", - "block", - "core-graphics-types 0.2.0", - "foreign-types", - "log", - "objc", - "paste", -] - -[[package]] -name = "miette" -version = "7.6.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "5f98efec8807c63c752b5bd61f862c165c115b0a35685bdcfd9238c7aeb592b7" -dependencies = [ - "cfg-if", - "miette-derive", - "serde", - "unicode-width 0.1.14", -] - -[[package]] -name = "miette-derive" -version = "7.6.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "db5b29714e950dbb20d5e6f74f9dcec4edbcc1067bb7f8ed198c097b8c1a818b" -dependencies = [ - "proc-macro2", - "quote", - "syn", -] - -[[package]] -name = "mundy" -version = "0.2.3" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "f32eb0db40f2df2bcfb05c93b8f73938d4c26ce9ac8881f1df0c8d3296921a73" -dependencies = [ - "android-build", - "async-io", - "cfg-if", - "dispatch", - "futures-channel", - "futures-lite", - "jni", - "ndk-context", - "objc2 0.6.4", - "objc2-app-kit 0.3.2", - "objc2-foundation 0.3.2", - "pin-project-lite", - "wasm-bindgen", - "wasm-bindgen-futures", - "web-sys", - "windows 0.62.2", - "zbus", -] - -[[package]] -name = "naga" -version = "27.0.3" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "066cf25f0e8b11ee0df221219010f213ad429855f57c494f995590c861a9a7d8" -dependencies = [ - "arrayvec 0.7.7", - "bit-set", - "bitflags 2.11.1", - "cfg-if", - "cfg_aliases", - "codespan-reporting", - "half", - "hashbrown 0.16.1", - "hexf-parse", - "indexmap 2.14.0", - "libm", - "log", - "num-traits", - "once_cell", - "rustc-hash 1.1.0", - "spirv", - "thiserror 2.0.18", - "unicode-ident", -] - -[[package]] -name = "ndk" -version = "0.9.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "c3f42e7bbe13d351b6bead8286a43aac9534b82bd3cc43e47037f012ebfd62d4" -dependencies = [ - "bitflags 2.11.1", - "jni-sys 0.3.1", - "log", - "ndk-sys", - "num_enum", - "raw-window-handle", - "thiserror 1.0.69", -] - -[[package]] -name = "ndk-context" -version = "0.1.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "27b02d87554356db9e9a873add8782d4ea6e3e58ea071a9adb9a2e8ddb884a8b" - -[[package]] -name = "ndk-sys" -version = "0.6.0+11769913" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "ee6cda3051665f1fb8d9e08fc35c96d5a244fb1be711a03b71118828afc9a873" -dependencies = [ - "jni-sys 0.3.1", -] - -[[package]] -name = "new_debug_unreachable" -version = "1.0.6" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "650eef8c711430f1a879fdd01d4745a7deea475becfb90269c06775983bbf086" - -[[package]] -name = "nonempty" -version = "0.12.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "9737e026353e5cd0736f98eddae28665118eb6f6600902a7f50db585621fecb6" -dependencies = [ - "serde", -] - -[[package]] -name = "num-conv" -version = "0.2.2" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "521739c6d2bac4aa25192232afe6841231376b2b26d4d9fae5ecf8ca5772e441" - -[[package]] -name = "num-traits" -version = "0.2.19" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "071dfc062690e90b734c0b2273ce72ad0ffa95f0c74596bc250dcfd960262841" -dependencies = [ - "autocfg", - "libm", -] - -[[package]] -name = "num_enum" -version = "0.7.6" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "5d0bca838442ec211fa11de3a8b0e0e8f3a4522575b5c4c06ed722e005036f26" -dependencies = [ - "num_enum_derive", - "rustversion", -] - -[[package]] -name = "num_enum_derive" -version = "0.7.6" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "680998035259dcfcafe653688bf2aa6d3e2dc05e98be6ab46afb089dc84f1df8" -dependencies = [ - "proc-macro-crate", - "proc-macro2", - "quote", - "syn", -] - -[[package]] -name = "objc" -version = "0.2.7" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "915b1b472bc21c53464d6c8461c9d3af805ba1ef837e1cac254428f4a77177b1" -dependencies = [ - "malloc_buf", -] - -[[package]] -name = "objc-sys" -version = "0.3.5" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "cdb91bdd390c7ce1a8607f35f3ca7151b65afc0ff5ff3b34fa350f7d7c7e4310" - -[[package]] -name = "objc2" -version = "0.5.2" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "46a785d4eeff09c14c487497c162e92766fbb3e4059a71840cecc03d9a50b804" -dependencies = [ - "objc-sys", - "objc2-encode", -] - -[[package]] -name = "objc2" -version = "0.6.4" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "3a12a8ed07aefc768292f076dc3ac8c48f3781c8f2d5851dd3d98950e8c5a89f" -dependencies = [ - "objc2-encode", -] - -[[package]] -name = "objc2-app-kit" -version = "0.2.2" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "e4e89ad9e3d7d297152b17d39ed92cd50ca8063a89a9fa569046d41568891eff" -dependencies = [ - "bitflags 2.11.1", - "block2 0.5.1", - "libc", - "objc2 0.5.2", - "objc2-core-data 0.2.2", - "objc2-core-image 0.2.2", - "objc2-foundation 0.2.2", - "objc2-quartz-core 0.2.2", -] - -[[package]] -name = "objc2-app-kit" -version = "0.3.2" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "d49e936b501e5c5bf01fda3a9452ff86dc3ea98ad5f283e1455153142d97518c" -dependencies = [ - "bitflags 2.11.1", - "block2 0.6.2", - "libc", - "objc2 0.6.4", - "objc2-cloud-kit 0.3.2", - "objc2-core-data 0.3.2", - "objc2-core-foundation", - "objc2-core-graphics", - "objc2-core-image 0.3.2", - "objc2-core-text", - "objc2-core-video", - "objc2-foundation 0.3.2", - "objc2-quartz-core 0.3.2", -] - -[[package]] -name = "objc2-cloud-kit" -version = "0.2.2" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "74dd3b56391c7a0596a295029734d3c1c5e7e510a4cb30245f8221ccea96b009" -dependencies = [ - "bitflags 2.11.1", - "block2 0.5.1", - "objc2 0.5.2", - "objc2-core-location", - "objc2-foundation 0.2.2", -] - -[[package]] -name = "objc2-cloud-kit" -version = "0.3.2" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "73ad74d880bb43877038da939b7427bba67e9dd42004a18b809ba7d87cee241c" -dependencies = [ - "bitflags 2.11.1", - "objc2 0.6.4", - "objc2-foundation 0.3.2", -] - -[[package]] -name = "objc2-contacts" -version = "0.2.2" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "a5ff520e9c33812fd374d8deecef01d4a840e7b41862d849513de77e44aa4889" -dependencies = [ - "block2 0.5.1", - "objc2 0.5.2", - "objc2-foundation 0.2.2", -] - -[[package]] -name = "objc2-core-data" -version = "0.2.2" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "617fbf49e071c178c0b24c080767db52958f716d9eabdf0890523aeae54773ef" -dependencies = [ - "bitflags 2.11.1", - "block2 0.5.1", - "objc2 0.5.2", - "objc2-foundation 0.2.2", -] - -[[package]] -name = "objc2-core-data" -version = "0.3.2" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "0b402a653efbb5e82ce4df10683b6b28027616a2715e90009947d50b8dd298fa" -dependencies = [ - "bitflags 2.11.1", - "objc2 0.6.4", - "objc2-foundation 0.3.2", -] - -[[package]] -name = "objc2-core-foundation" -version = "0.3.2" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "2a180dd8642fa45cdb7dd721cd4c11b1cadd4929ce112ebd8b9f5803cc79d536" -dependencies = [ - "bitflags 2.11.1", - "dispatch2", - "objc2 0.6.4", -] - -[[package]] -name = "objc2-core-graphics" -version = "0.3.2" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "e022c9d066895efa1345f8e33e584b9f958da2fd4cd116792e15e07e4720a807" -dependencies = [ - "bitflags 2.11.1", - "dispatch2", - "objc2 0.6.4", - "objc2-core-foundation", - "objc2-io-surface", -] - -[[package]] -name = "objc2-core-image" -version = "0.2.2" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "55260963a527c99f1819c4f8e3b47fe04f9650694ef348ffd2227e8196d34c80" -dependencies = [ - "block2 0.5.1", - "objc2 0.5.2", - "objc2-foundation 0.2.2", - "objc2-metal", -] - -[[package]] -name = "objc2-core-image" -version = "0.3.2" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "e5d563b38d2b97209f8e861173de434bd0214cf020e3423a52624cd1d989f006" -dependencies = [ - "objc2 0.6.4", - "objc2-foundation 0.3.2", -] - -[[package]] -name = "objc2-core-location" -version = "0.2.2" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "000cfee34e683244f284252ee206a27953279d370e309649dc3ee317b37e5781" -dependencies = [ - "block2 0.5.1", - "objc2 0.5.2", - "objc2-contacts", - "objc2-foundation 0.2.2", -] - -[[package]] -name = "objc2-core-text" -version = "0.3.2" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "0cde0dfb48d25d2b4862161a4d5fcc0e3c24367869ad306b0c9ec0073bfed92d" -dependencies = [ - "bitflags 2.11.1", - "objc2 0.6.4", - "objc2-core-foundation", - "objc2-core-graphics", -] - -[[package]] -name = "objc2-core-video" -version = "0.3.2" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "d425caf1df73233f29fd8a5c3e5edbc30d2d4307870f802d18f00d83dc5141a6" -dependencies = [ - "bitflags 2.11.1", - "objc2 0.6.4", - "objc2-core-foundation", - "objc2-core-graphics", - "objc2-io-surface", -] - -[[package]] -name = "objc2-encode" -version = "4.1.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "ef25abbcd74fb2609453eb695bd2f860d389e457f67dc17cafc8b8cbc89d0c33" - -[[package]] -name = "objc2-foundation" -version = "0.2.2" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "0ee638a5da3799329310ad4cfa62fbf045d5f56e3ef5ba4149e7452dcf89d5a8" -dependencies = [ - "bitflags 2.11.1", - "block2 0.5.1", - "dispatch", - "libc", - "objc2 0.5.2", -] - -[[package]] -name = "objc2-foundation" -version = "0.3.2" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "e3e0adef53c21f888deb4fa59fc59f7eb17404926ee8a6f59f5df0fd7f9f3272" -dependencies = [ - "bitflags 2.11.1", - "block2 0.6.2", - "libc", - "objc2 0.6.4", - "objc2-core-foundation", -] - -[[package]] -name = "objc2-io-surface" -version = "0.3.2" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "180788110936d59bab6bd83b6060ffdfffb3b922ba1396b312ae795e1de9d81d" -dependencies = [ - "bitflags 2.11.1", - "objc2 0.6.4", - "objc2-core-foundation", -] - -[[package]] -name = "objc2-link-presentation" -version = "0.2.2" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "a1a1ae721c5e35be65f01a03b6d2ac13a54cb4fa70d8a5da293d7b0020261398" -dependencies = [ - "block2 0.5.1", - "objc2 0.5.2", - "objc2-app-kit 0.2.2", - "objc2-foundation 0.2.2", -] - -[[package]] -name = "objc2-metal" -version = "0.2.2" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "dd0cba1276f6023976a406a14ffa85e1fdd19df6b0f737b063b95f6c8c7aadd6" -dependencies = [ - "bitflags 2.11.1", - "block2 0.5.1", - "objc2 0.5.2", - "objc2-foundation 0.2.2", -] - -[[package]] -name = "objc2-quartz-core" -version = "0.2.2" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "e42bee7bff906b14b167da2bac5efe6b6a07e6f7c0a21a7308d40c960242dc7a" -dependencies = [ - "bitflags 2.11.1", - "block2 0.5.1", - "objc2 0.5.2", - "objc2-foundation 0.2.2", - "objc2-metal", -] - -[[package]] -name = "objc2-quartz-core" -version = "0.3.2" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "96c1358452b371bf9f104e21ec536d37a650eb10f7ee379fff67d2e08d537f1f" -dependencies = [ - "bitflags 2.11.1", - "objc2 0.6.4", - "objc2-core-foundation", - "objc2-foundation 0.3.2", -] - -[[package]] -name = "objc2-symbols" -version = "0.2.2" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "0a684efe3dec1b305badae1a28f6555f6ddd3bb2c2267896782858d5a78404dc" -dependencies = [ - "objc2 0.5.2", - "objc2-foundation 0.2.2", -] - -[[package]] -name = "objc2-ui-kit" -version = "0.2.2" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "b8bb46798b20cd6b91cbd113524c490f1686f4c4e8f49502431415f3512e2b6f" -dependencies = [ - "bitflags 2.11.1", - "block2 0.5.1", - "objc2 0.5.2", - "objc2-cloud-kit 0.2.2", - "objc2-core-data 0.2.2", - "objc2-core-image 0.2.2", - "objc2-core-location", - "objc2-foundation 0.2.2", - "objc2-link-presentation", - "objc2-quartz-core 0.2.2", - "objc2-symbols", - "objc2-uniform-type-identifiers", - "objc2-user-notifications", -] - -[[package]] -name = "objc2-uniform-type-identifiers" -version = "0.2.2" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "44fa5f9748dbfe1ca6c0b79ad20725a11eca7c2218bceb4b005cb1be26273bfe" -dependencies = [ - "block2 0.5.1", - "objc2 0.5.2", - "objc2-foundation 0.2.2", -] - -[[package]] -name = "objc2-user-notifications" -version = "0.2.2" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "76cfcbf642358e8689af64cee815d139339f3ed8ad05103ed5eaf73db8d84cb3" -dependencies = [ - "bitflags 2.11.1", - "block2 0.5.1", - "objc2 0.5.2", - "objc2-core-location", - "objc2-foundation 0.2.2", -] - -[[package]] -name = "object" -version = "0.37.3" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "ff76201f031d8863c38aa7f905eca4f53abbfa15f609db4277d44cd8938f33fe" -dependencies = [ - "memchr", -] - -[[package]] -name = "once_cell" -version = "1.21.4" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "9f7c3e4beb33f85d45ae3e3a1792185706c8e16d043238c593331cc7cd313b50" - -[[package]] -name = "orbclient" -version = "0.3.55" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "5df339f526ea9a60e371768d50efc2f2508c7203290731565d1f7a6f71d21747" -dependencies = [ - "libc", - "libredox", -] - -[[package]] -name = "ordered-float" -version = "5.3.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "b7d950ca161dc355eaf28f82b11345ed76c6e1f6eb1f4f4479e0323b9e2fbd0e" -dependencies = [ - "num-traits", -] - -[[package]] -name = "ordered-stream" -version = "0.2.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "9aa2b01e1d916879f73a53d01d1d6cee68adbb31d6d9177a8cfce093cced1d50" -dependencies = [ - "futures-core", - "pin-project-lite", -] - -[[package]] -name = "owned_ttf_parser" -version = "0.25.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "36820e9051aca1014ddc75770aab4d68bc1e9e632f0f5627c4086bc216fb583b" -dependencies = [ - "ttf-parser", -] - -[[package]] -name = "parking" -version = "2.2.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "f38d5652c16fde515bb1ecef450ab0f6a219d619a7274976324d5e377f7dceba" - -[[package]] -name = "parking_lot" -version = "0.12.5" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "93857453250e3077bd71ff98b6a65ea6621a19bb0f559a85248955ac12c45a1a" -dependencies = [ - "lock_api", - "parking_lot_core", -] - -[[package]] -name = "parking_lot_core" -version = "0.9.12" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "2621685985a2ebf1c516881c026032ac7deafcda1a2c9b7850dc81e3dfcb64c1" -dependencies = [ - "cfg-if", - "libc", - "redox_syscall 0.5.18", - "smallvec", - "windows-link", -] - -[[package]] -name = "paste" -version = "1.0.15" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "57c0d7b74b563b49d38dae00a0c37d4d6de9b432382b2892f0574ddcae73fd0a" - -[[package]] -name = "percent-encoding" -version = "2.3.2" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "9b4f627cb1b25917193a259e49bdad08f671f8d9708acfd5fe0a8c1455d87220" - -[[package]] -name = "petgraph" -version = "0.7.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "3672b37090dbd86368a4145bc067582552b29c27377cad4e0a306c97f9bd7772" -dependencies = [ - "fixedbitset", - "indexmap 2.14.0", -] - -[[package]] -name = "phf_shared" -version = "0.11.3" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "67eabc2ef2a60eb7faa00097bd1ffdb5bd28e62bf39990626a582201b7a754e5" -dependencies = [ - "siphasher", -] - -[[package]] -name = "pico-args" -version = "0.5.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "5be167a7af36ee22fe3115051bc51f6e6c7054c9348e28deb4f49bd6f705a315" - -[[package]] -name = "pin-project" -version = "1.1.13" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "2466b2336ed02bcdca6b294417127b90ec92038d1d5c4fbeac971a922e0e0924" -dependencies = [ - "pin-project-internal", -] - -[[package]] -name = "pin-project-internal" -version = "1.1.13" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "c96395f0a926bc13b1c17622aaddda1ecb55d49c8f1bf9777e4d877800a43f8b" -dependencies = [ - "proc-macro2", - "quote", - "syn", -] - -[[package]] -name = "pin-project-lite" -version = "0.2.17" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "a89322df9ebe1c1578d689c92318e070967d1042b512afbe49518723f4e6d5cd" - -[[package]] -name = "pin-utils" -version = "0.1.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "8b870d8c151b6f2fb93e84a13146138f05d02ed11c7e7c54f8826aaaf7c9f184" - -[[package]] -name = "piper" -version = "0.2.5" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "c835479a4443ded371d6c535cbfd8d31ad92c5d23ae9770a61bc155e4992a3c1" -dependencies = [ - "atomic-waker", - "fastrand", - "futures-io", -] - -[[package]] -name = "pkg-config" -version = "0.3.33" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "19f132c84eca552bf34cab8ec81f1c1dcc229b811638f9d283dceabe58c5569e" - -[[package]] -name = "plain" -version = "0.2.3" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "b4596b6d070b27117e987119b4dac604f3c58cfb0b191112e24771b2faeac1a6" - -[[package]] -name = "polling" -version = "3.11.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "5d0e4f59085d47d8241c88ead0f274e8a0cb551f3625263c05eb8dd897c34218" -dependencies = [ - "cfg-if", - "concurrent-queue", - "hermit-abi", - "pin-project-lite", - "rustix 1.1.4", - "windows-sys 0.61.2", -] - -[[package]] -name = "portable-atomic" -version = "1.13.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "c33a9471896f1c69cecef8d20cbe2f7accd12527ce60845ff44c153bb2a21b49" - -[[package]] -name = "portable-atomic-util" -version = "0.2.7" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "c2a106d1259c23fac8e543272398ae0e3c0b8d33c88ed73d0cc71b0f1d902618" -dependencies = [ - "portable-atomic", -] - -[[package]] -name = "powerfmt" -version = "0.2.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "439ee305def115ba05938db6eb1644ff94165c5ab5e9420d1c1bcedbba909391" - -[[package]] -name = "precomputed-hash" -version = "0.1.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "925383efa346730478fb4838dbe9137d2a47675ad789c546d150a6e1dd4ab31c" - -[[package]] -name = "presser" -version = "0.3.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "e8cf8e6a8aa66ce33f63993ffc4ea4271eb5b0530a9002db8455ea6050c77bfa" - -[[package]] -name = "pretty" -version = "0.12.5" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "0d22152487193190344590e4f30e219cf3fe140d9e7a3fdb683d82aa2c5f4156" -dependencies = [ - "arrayvec 0.5.2", - "typed-arena", - "unicode-width 0.2.2", -] - -[[package]] -name = "proc-macro-crate" -version = "3.5.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "e67ba7e9b2b56446f1d419b1d807906278ffa1a658a8a5d8a39dcb1f5a78614f" -dependencies = [ - "toml_edit", -] - -[[package]] -name = "proc-macro2" -version = "1.0.106" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "8fd00f0bb2e90d81d1044c2b32617f68fcb9fa3bb7640c23e9c748e53fb30934" -dependencies = [ - "unicode-ident", -] - -[[package]] -name = "profiling" -version = "1.0.18" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "3d595e54a326bc53c1c197b32d295e14b169e3cfeaa8dc82b529f947fba6bcf5" - -[[package]] -name = "psm" -version = "0.1.31" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "645dbe486e346d9b5de3ef16ede18c26e6c70ad97418f4874b8b1889d6e761ea" -dependencies = [ - "ar_archive_writer", - "cc", -] - -[[package]] -name = "quick-xml" -version = "0.39.4" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "cdcc8dd4e2f670d309a5f0e83fe36dfdc05af317008fea29144da1a2ac858e5e" -dependencies = [ - "memchr", -] - -[[package]] -name = "quote" -version = "1.0.45" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "41f2619966050689382d2b44f664f4bc593e129785a36d6ee376ddf37259b924" -dependencies = [ - "proc-macro2", -] - -[[package]] -name = "r-efi" -version = "5.3.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "69cdb34c158ceb288df11e18b4bd39de994f6657d83847bdffdbd7f346754b0f" - -[[package]] -name = "r-efi" -version = "6.0.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "f8dcc9c7d52a811697d2151c701e0d08956f92b0e24136cf4cf27b57a6a0d9bf" - -[[package]] -name = "range-alloc" -version = "0.1.5" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "ca45419789ae5a7899559e9512e58ca889e41f04f1f2445e9f4b290ceccd1d08" - -[[package]] -name = "rangemap" -version = "1.7.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "973443cf09a9c8656b574a866ab68dfa19f0867d0340648c7d2f6a71b8a8ea68" - -[[package]] -name = "ratatoskr-build" -version = "0.1.0" -dependencies = [ - "klcompile", -] - -[[package]] -name = "raw-window-handle" -version = "0.6.2" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "20675572f6f24e9e76ef639bc5552774ed45f1c30e2951e1e99c59888861c539" - -[[package]] -name = "read-fonts" -version = "0.35.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "6717cf23b488adf64b9d711329542ba34de147df262370221940dfabc2c91358" -dependencies = [ - "bytemuck", - "core_maths", - "font-types 0.10.1", -] - -[[package]] -name = "read-fonts" -version = "0.39.2" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "c4ed38b89c2c77ff968c524145ad65fb010f38af5c7a224b53b81d47ac2daa81" -dependencies = [ - "bytemuck", - "font-types 0.11.3", -] - -[[package]] -name = "redox_syscall" -version = "0.4.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "4722d768eff46b75989dd134e5c353f0d6296e5aaa3132e776cbdb56be7731aa" -dependencies = [ - "bitflags 1.3.2", -] - -[[package]] -name = "redox_syscall" -version = "0.5.18" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "ed2bf2547551a7053d6fdfafda3f938979645c44812fbfcda098faae3f1a362d" -dependencies = [ - "bitflags 2.11.1", -] - -[[package]] -name = "redox_syscall" -version = "0.8.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "5b44b894f2a6e36457d665d1e08c3866add6ed5e70050c1b4ba8a8ddedb02ce7" -dependencies = [ - "bitflags 2.11.1", -] - -[[package]] -name = "ref-cast" -version = "1.0.25" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "f354300ae66f76f1c85c5f84693f0ce81d747e2c3f21a45fef496d89c960bf7d" -dependencies = [ - "ref-cast-impl", -] - -[[package]] -name = "ref-cast-impl" -version = "1.0.25" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "b7186006dcb21920990093f30e3dea63b7d6e977bf1256be20c3563a5db070da" -dependencies = [ - "proc-macro2", - "quote", - "syn", -] - -[[package]] -name = "regalloc2" -version = "0.15.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "de2c52737737f8609e94f975dee22854a2d5c125772d4b1cf292120f4d45c186" -dependencies = [ - "allocator-api2", - "bumpalo", - "hashbrown 0.17.1", - "log", - "rustc-hash 2.1.2", - "smallvec", -] - -[[package]] -name = "regex" -version = "1.12.3" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "e10754a14b9137dd7b1e3e5b0493cc9171fdd105e0ab477f51b72e7f3ac0e276" -dependencies = [ - "aho-corasick", - "memchr", - "regex-automata", - "regex-syntax", -] - -[[package]] -name = "regex-automata" -version = "0.4.14" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "6e1dd4122fc1595e8162618945476892eefca7b88c52820e74af6262213cae8f" -dependencies = [ - "aho-corasick", - "memchr", - "regex-syntax", -] - -[[package]] -name = "regex-syntax" -version = "0.8.10" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "dc897dd8d9e8bd1ed8cdad82b5966c3e0ecae09fb1907d58efaa013543185d0a" - -[[package]] -name = "region" -version = "3.0.2" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "e6b6ebd13bc009aef9cd476c1310d49ac354d36e240cf1bd753290f3dc7199a7" -dependencies = [ - "bitflags 1.3.2", - "libc", - "mach2", - "windows-sys 0.52.0", -] - -[[package]] -name = "renderdoc-sys" -version = "1.1.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "19b30a45b0cd0bcca8037f3d0dc3421eaf95327a17cad11964fb8179b4fc4832" - -[[package]] -name = "roxmltree" -version = "0.20.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "6c20b6793b5c2fa6553b250154b78d6d0db37e72700ae35fad9387a46f487c97" - -[[package]] -name = "rustc-hash" -version = "1.1.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "08d43f7aa6b08d49f382cde6a7982047c3426db949b1424bc4b7ec9ae12c6ce2" - -[[package]] -name = "rustc-hash" -version = "2.1.2" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "94300abf3f1ae2e2b8ffb7b58043de3d399c73fa6f4b73826402a5c457614dbe" - -[[package]] -name = "rustc-literal-escaper" -version = "0.0.7" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "8be87abb9e40db7466e0681dc8ecd9dcfd40360cb10b4c8fe24a7c4c3669b198" - -[[package]] -name = "rustc_version" -version = "0.4.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "cfcb3a22ef46e85b45de6ee7e79d063319ebb6594faafcf1c225ea92ab6e9b92" -dependencies = [ - "semver", -] - -[[package]] -name = "rustix" -version = "0.38.44" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "fdb5bc1ae2baa591800df16c9ca78619bf65c0488b41b96ccec5d11220d8c154" -dependencies = [ - "bitflags 2.11.1", - "errno", - "libc", - "linux-raw-sys 0.4.15", - "windows-sys 0.52.0", -] - -[[package]] -name = "rustix" -version = "1.1.4" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "b6fe4565b9518b83ef4f91bb47ce29620ca828bd32cb7e408f0062e9930ba190" -dependencies = [ - "bitflags 2.11.1", - "errno", - "libc", - "linux-raw-sys 0.12.1", - "windows-sys 0.61.2", -] - -[[package]] -name = "rustversion" -version = "1.0.22" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "b39cdef0fa800fc44525c84ccb54a029961a8215f9619753635a9c0d2538d46d" - -[[package]] -name = "same-file" -version = "1.0.6" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "93fc1dc3aaa9bfed95e02e6eadabb4baf7e3078b0bd1b4d7b6b0b68378900502" -dependencies = [ - "winapi-util", -] - -[[package]] -name = "schemars" -version = "0.9.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "4cd191f9397d57d581cddd31014772520aa448f65ef991055d7f61582c65165f" -dependencies = [ - "dyn-clone", - "ref-cast", - "serde", - "serde_json", -] - -[[package]] -name = "schemars" -version = "1.2.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "a2b42f36aa1cd011945615b92222f6bf73c599a102a300334cd7f8dbeec726cc" -dependencies = [ - "dyn-clone", - "ref-cast", - "serde", - "serde_json", -] - -[[package]] -name = "scoped-tls" -version = "1.0.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "e1cf6437eb19a8f4a6cc0f7dca544973b0b78843adbfeb3683d1a94a0024a294" - -[[package]] -name = "scopeguard" -version = "1.2.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "94143f37725109f92c262ed2cf5e59bce7498c01bcc1502d7b9afe439a4e9f49" - -[[package]] -name = "sctk-adwaita" -version = "0.10.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "b6277f0217056f77f1d8f49f2950ac6c278c0d607c45f5ee99328d792ede24ec" -dependencies = [ - "ab_glyph", - "log", - "memmap2 0.9.10", - "smithay-client-toolkit 0.19.2", - "tiny-skia", -] - -[[package]] -name = "self_cell" -version = "1.2.2" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "b12e76d157a900eb52e81bc6e9f3069344290341720e9178cde2407113ac8d89" - -[[package]] -name = "semver" -version = "1.0.28" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "8a7852d02fc848982e0c167ef163aaff9cd91dc640ba85e263cb1ce46fae51cd" - -[[package]] -name = "serde" -version = "1.0.228" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "9a8e94ea7f378bd32cbbd37198a4a91436180c5bb472411e48b5ec2e2124ae9e" -dependencies = [ - "serde_core", - "serde_derive", -] - -[[package]] -name = "serde_core" -version = "1.0.228" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "41d385c7d4ca58e59fc732af25c3983b67ac852c1a25000afe1175de458b67ad" -dependencies = [ - "serde_derive", -] - -[[package]] -name = "serde_derive" -version = "1.0.228" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "d540f220d3187173da220f885ab66608367b6574e925011a9353e4badda91d79" -dependencies = [ - "proc-macro2", - "quote", - "syn", -] - -[[package]] -name = "serde_json" -version = "1.0.150" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "e8014e44b4736ed0538adeecded0fce2a272f22dc9578a7eb6b2d9993c74cfb9" -dependencies = [ - "indexmap 2.14.0", - "itoa", - "memchr", - "serde", - "serde_core", - "zmij", -] - -[[package]] -name = "serde_repr" -version = "0.1.20" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "175ee3e80ae9982737ca543e96133087cbd9a485eecc3bc4de9c1a37b47ea59c" -dependencies = [ - "proc-macro2", - "quote", - "syn", -] - -[[package]] -name = "serde_with" -version = "3.20.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "e72c1c2cb7b223fafb600a619537a871c2818583d619401b785e7c0b746ccde2" -dependencies = [ - "base64", - "bs58", - "chrono", - "hex", - "indexmap 1.9.3", - "indexmap 2.14.0", - "schemars 0.9.0", - "schemars 1.2.1", - "serde_core", - "serde_json", - "serde_with_macros", - "time", -] - -[[package]] -name = "serde_with_macros" -version = "3.20.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "b90c488738ecb4fb0262f41f43bc40efc5868d9fb744319ddf5f5317f417bfac" -dependencies = [ - "darling", - "proc-macro2", - "quote", - "syn", -] - -[[package]] -name = "sha3" -version = "0.10.9" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "77fd7028345d415a4034cf8777cd4f8ab1851274233b45f84e3d955502d93874" -dependencies = [ - "digest", - "keccak", -] - -[[package]] -name = "shen-cedar-authz" -version = "0.1.0" -dependencies = [ - "cedar-policy", - "shen-rust", -] - -[[package]] -name = "shen-rust" -version = "0.1.0" -dependencies = [ - "cedar-policy", - "cranelift-codegen", - "cranelift-frontend", - "cranelift-jit", - "cranelift-module", - "cranelift-native", - "smallvec", -] - -[[package]] -name = "shen-rust-bin" -version = "0.1.0" -dependencies = [ - "klcompile", - "shen-rust", -] - -[[package]] -name = "shencalc-iced" -version = "0.1.0" -dependencies = [ - "iced", - "shenffi", -] - -[[package]] -name = "shenffi" -version = "0.1.0" -dependencies = [ - "shen-rust", -] - -[[package]] -name = "shengen-rust" -version = "0.1.0" - -[[package]] -name = "shlex" -version = "1.3.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "0fda2ff0d084019ba4d7c6f371c95d8fd75ce3524c3cb8fb653a3023f6323e64" - -[[package]] -name = "signal-hook-registry" -version = "1.4.8" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "c4db69cba1110affc0e9f7bcd48bbf87b3f4fc7c61fc9155afd4c469eb3d6c1b" -dependencies = [ - "errno", - "libc", -] - -[[package]] -name = "simd_cesu8" -version = "1.1.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "94f90157bb87cddf702797c5dadfa0be7d266cdf49e22da2fcaa32eff75b2c33" -dependencies = [ - "rustc_version", - "simdutf8", -] - -[[package]] -name = "simdutf8" -version = "0.1.5" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "e3a9fe34e3e7a50316060351f37187a3f546bce95496156754b601a5fa71b76e" - -[[package]] -name = "siphasher" -version = "1.0.3" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "8ee5873ec9cce0195efcb7a4e9507a04cd49aec9c83d0389df45b1ef7ba2e649" - -[[package]] -name = "skrifa" -version = "0.37.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "8c31071dedf532758ecf3fed987cdb4bd9509f900e026ab684b4ecb81ea49841" -dependencies = [ - "bytemuck", - "read-fonts 0.35.0", -] - -[[package]] -name = "skrifa" -version = "0.42.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "0c34617370ae968efb7161bb2beb517d9084659aae19e24b89e3db25b46e4564" -dependencies = [ - "bytemuck", - "read-fonts 0.39.2", -] - -[[package]] -name = "slab" -version = "0.4.12" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "0c790de23124f9ab44544d7ac05d60440adc586479ce501c1d6d7da3cd8c9cf5" - -[[package]] -name = "slotmap" -version = "1.1.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "bdd58c3c93c3d278ca835519292445cb4b0d4dc59ccfdf7ceadaab3f8aeb4038" -dependencies = [ - "version_check", -] - -[[package]] -name = "smallvec" -version = "1.15.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "67b1b7a3b5fe4f1376887184045fcf45c69e92af734b7aaddc05fb777b6fbd03" - -[[package]] -name = "smithay-client-toolkit" -version = "0.19.2" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "3457dea1f0eb631b4034d61d4d8c32074caa6cd1ab2d59f2327bd8461e2c0016" -dependencies = [ - "bitflags 2.11.1", - "calloop 0.13.0", - "calloop-wayland-source 0.3.0", - "cursor-icon", - "libc", - "log", - "memmap2 0.9.10", - "rustix 0.38.44", - "thiserror 1.0.69", - "wayland-backend", - "wayland-client", - "wayland-csd-frame", - "wayland-cursor", - "wayland-protocols", - "wayland-protocols-wlr", - "wayland-scanner", - "xkeysym", -] - -[[package]] -name = "smithay-client-toolkit" -version = "0.20.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "0512da38f5e2b31201a93524adb8d3136276fa4fe4aafab4e1f727a82b534cc0" -dependencies = [ - "bitflags 2.11.1", - "calloop 0.14.4", - "calloop-wayland-source 0.4.1", - "cursor-icon", - "libc", - "log", - "memmap2 0.9.10", - "rustix 1.1.4", - "thiserror 2.0.18", - "wayland-backend", - "wayland-client", - "wayland-csd-frame", - "wayland-cursor", - "wayland-protocols", - "wayland-protocols-experimental", - "wayland-protocols-misc", - "wayland-protocols-wlr", - "wayland-scanner", - "xkeysym", -] - -[[package]] -name = "smithay-clipboard" -version = "0.7.3" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "71704c03f739f7745053bde45fa203a46c58d25bc5c4efba1d9a60e9dba81226" -dependencies = [ - "libc", - "smithay-client-toolkit 0.20.0", - "wayland-backend", -] - -[[package]] -name = "smol_str" -version = "0.2.2" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "dd538fb6910ac1099850255cf94a94df6551fbdd602454387d0adb2d1ca6dead" -dependencies = [ - "serde", -] - -[[package]] -name = "smol_str" -version = "0.3.6" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "4aaa7368fcf4852a4c2dd92df0cace6a71f2091ca0a23391ce7f3a31833f1523" -dependencies = [ - "borsh", - "serde_core", -] - -[[package]] -name = "softbuffer" -version = "0.4.8" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "aac18da81ebbf05109ab275b157c22a653bb3c12cf884450179942f81bcbf6c3" -dependencies = [ - "as-raw-xcb-connection", - "bytemuck", - "fastrand", - "js-sys", - "memmap2 0.9.10", - "ndk", - "objc2 0.6.4", - "objc2-core-foundation", - "objc2-core-graphics", - "objc2-foundation 0.3.2", - "objc2-quartz-core 0.3.2", - "raw-window-handle", - "redox_syscall 0.5.18", - "rustix 1.1.4", - "tiny-xlib", - "tracing", - "wasm-bindgen", - "wayland-backend", - "wayland-client", - "wayland-sys", - "web-sys", - "windows-sys 0.61.2", - "x11rb", -] - -[[package]] -name = "spirv" -version = "0.3.0+sdk-1.3.268.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "eda41003dc44290527a59b13432d4a0379379fa074b70174882adfbdfd917844" -dependencies = [ - "bitflags 2.11.1", -] - -[[package]] -name = "stable_deref_trait" -version = "1.2.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "6ce2be8dc25455e1f91df71bfa12ad37d7af1092ae736f3a6cd0e37bc7810596" - -[[package]] -name = "stacker" -version = "0.1.24" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "640c8cdd92b6b12f5bcb1803ca3bbf5ab96e5e6b6b96b9ab77dabe9e880b3190" -dependencies = [ - "cc", - "cfg-if", - "libc", - "psm", - "windows-sys 0.61.2", -] - -[[package]] -name = "static_assertions" -version = "1.1.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "a2eb9349b6444b326872e140eb1cf5e7c522154d69e7a0ffb0fb81c06b37543f" - -[[package]] -name = "strict-num" -version = "0.1.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "6637bab7722d379c8b41ba849228d680cc12d0a45ba1fa2b48f2a30577a06731" - -[[package]] -name = "string_cache" -version = "0.8.9" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "bf776ba3fa74f83bf4b63c3dcbbf82173db2632ed8452cb2d891d33f459de70f" -dependencies = [ - "new_debug_unreachable", - "parking_lot", - "phf_shared", - "precomputed-hash", -] - -[[package]] -name = "strsim" -version = "0.11.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "7da8b5736845d9f2fcb837ea5d9e2628564b3b043a70948a3f0b778838c5fb4f" - -[[package]] -name = "svg_fmt" -version = "0.4.5" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "0193cc4331cfd2f3d2011ef287590868599a2f33c3e69bc22c1a3d3acf9e02fb" - -[[package]] -name = "swash" -version = "0.2.9" +name = "rustc-literal-escaper" +version = "0.0.7" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "0811b01ca2c4e8718760713911feaf4675c24f94e50530a015ec646cfb622f7c" -dependencies = [ - "skrifa 0.42.1", - "yazi", - "zeno", -] +checksum = "8be87abb9e40db7466e0681dc8ecd9dcfd40360cb10b4c8fe24a7c4c3669b198" [[package]] -name = "syn" -version = "2.0.117" +name = "rustversion" +version = "1.0.22" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "e665b8803e7b1d2a727f4023456bbbbe74da67099c585258af0ad9c5013b9b99" -dependencies = [ - "proc-macro2", - "quote", - "unicode-ident", -] +checksum = "b39cdef0fa800fc44525c84ccb54a029961a8215f9619753635a9c0d2538d46d" [[package]] -name = "sys-locale" -version = "0.3.2" +name = "same-file" +version = "1.0.6" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "8eab9a99a024a169fe8a903cf9d4a3b3601109bcc13bd9e3c6fff259138626c4" +checksum = "93fc1dc3aaa9bfed95e02e6eadabb4baf7e3078b0bd1b4d7b6b0b68378900502" dependencies = [ - "libc", + "winapi-util", ] [[package]] -name = "target-lexicon" -version = "0.13.5" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "adb6935a6f5c20170eeceb1a3835a49e12e19d792f6dd344ccc76a985ca5a6ca" - -[[package]] -name = "tempfile" -version = "3.27.0" +name = "schemars" +version = "0.9.0" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "32497e9a4c7b38532efcdebeef879707aa9f794296a4f0244f6f69e9bc8574bd" +checksum = "4cd191f9397d57d581cddd31014772520aa448f65ef991055d7f61582c65165f" dependencies = [ - "fastrand", - "getrandom 0.4.3", - "once_cell", - "rustix 1.1.4", - "windows-sys 0.61.2", + "dyn-clone", + "ref-cast", + "serde", + "serde_json", ] [[package]] -name = "term" +name = "schemars" version = "1.2.1" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "d8c27177b12a6399ffc08b98f76f7c9a1f4fe9fc967c784c5a071fa8d93cf7e1" +checksum = "a2b42f36aa1cd011945615b92222f6bf73c599a102a300334cd7f8dbeec726cc" dependencies = [ - "windows-sys 0.61.2", + "dyn-clone", + "ref-cast", + "serde", + "serde_json", ] [[package]] -name = "termcolor" -version = "1.4.1" +name = "scopeguard" +version = "1.2.0" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "06794f8f6c5c898b3275aebefa6b8a1cb24cd2c6c79397ab15774837a0bc5755" -dependencies = [ - "winapi-util", -] +checksum = "94143f37725109f92c262ed2cf5e59bce7498c01bcc1502d7b9afe439a4e9f49" [[package]] -name = "thiserror" -version = "1.0.69" +name = "semver" +version = "1.0.28" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "b6aaf5339b578ea85b50e080feb250a3e8ae8cfcdff9a461c9ec2904bc923f52" -dependencies = [ - "thiserror-impl 1.0.69", -] +checksum = "8a7852d02fc848982e0c167ef163aaff9cd91dc640ba85e263cb1ce46fae51cd" [[package]] -name = "thiserror" -version = "2.0.18" +name = "serde" +version = "1.0.228" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "4288b5bcbc7920c07a1149a35cf9590a2aa808e0bc1eafaade0b80947865fbc4" +checksum = "9a8e94ea7f378bd32cbbd37198a4a91436180c5bb472411e48b5ec2e2124ae9e" dependencies = [ - "thiserror-impl 2.0.18", + "serde_core", + "serde_derive", ] [[package]] -name = "thiserror-impl" -version = "1.0.69" +name = "serde_core" +version = "1.0.228" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "4fee6c4efc90059e10f81e6d42c60a18f76588c3d74cb83a0b242a2b6c7504c1" +checksum = "41d385c7d4ca58e59fc732af25c3983b67ac852c1a25000afe1175de458b67ad" dependencies = [ - "proc-macro2", - "quote", - "syn", + "serde_derive", ] [[package]] -name = "thiserror-impl" -version = "2.0.18" +name = "serde_derive" +version = "1.0.228" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "ebc4ee7f67670e9b64d05fa4253e753e016c6c95ff35b89b7941d6b856dec1d5" +checksum = "d540f220d3187173da220f885ab66608367b6574e925011a9353e4badda91d79" dependencies = [ "proc-macro2", "quote", @@ -3879,748 +1237,415 @@ dependencies = [ ] [[package]] -name = "time" -version = "0.3.47" +name = "serde_json" +version = "1.0.150" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "743bd48c283afc0388f9b8827b976905fb217ad9e647fae3a379a9283c4def2c" +checksum = "e8014e44b4736ed0538adeecded0fce2a272f22dc9578a7eb6b2d9993c74cfb9" dependencies = [ - "deranged", + "indexmap 2.14.0", "itoa", - "num-conv", - "powerfmt", - "serde_core", - "time-core", - "time-macros", -] - -[[package]] -name = "time-core" -version = "0.1.8" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "7694e1cfe791f8d31026952abf09c69ca6f6fa4e1a1229e18988f06a04a12dca" - -[[package]] -name = "time-macros" -version = "0.2.27" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "2e70e4c5a0e0a8a4823ad65dfe1a6930e4f4d756dcd9dd7939022b5e8c501215" -dependencies = [ - "num-conv", - "time-core", -] - -[[package]] -name = "tiny-skia" -version = "0.11.4" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "83d13394d44dae3207b52a326c0c85a8bf87f1541f23b0d143811088497b09ab" -dependencies = [ - "arrayref", - "arrayvec 0.7.7", - "bytemuck", - "cfg-if", - "log", - "tiny-skia-path", -] - -[[package]] -name = "tiny-skia-path" -version = "0.11.4" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "9c9e7fc0c2e86a30b117d0462aa261b72b7a99b7ebd7deb3a14ceda95c5bdc93" -dependencies = [ - "arrayref", - "bytemuck", - "strict-num", -] - -[[package]] -name = "tiny-xlib" -version = "0.2.5" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "a90a0ca3ee6a69f2ad28fd11621a4c3f03b371f366be500b64df260c4ffbafb4" -dependencies = [ - "as-raw-xcb-connection", - "ctor", - "libloading", - "pkg-config", - "tracing", -] - -[[package]] -name = "tinyvec" -version = "1.11.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "3e61e67053d25a4e82c844e8424039d9745781b3fc4f32b8d55ed50f5f667ef3" -dependencies = [ - "tinyvec_macros", -] - -[[package]] -name = "tinyvec_macros" -version = "0.1.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "1f3ccbac311fea05f86f61904b462b55fb3df8837a366dfc601a0161d0532f20" - -[[package]] -name = "toml_datetime" -version = "1.1.1+spec-1.1.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "3165f65f62e28e0115a00b2ebdd37eb6f3b641855f9d636d3cd4103767159ad7" -dependencies = [ + "memchr", + "serde", "serde_core", + "zmij", ] [[package]] -name = "toml_edit" -version = "0.25.12+spec-1.1.0" +name = "serde_with" +version = "3.20.0" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "d2153edc6955a6c354fad8f5efd38b6a8769bdccf9fe50f8e1329f81b0baa5d7" +checksum = "e72c1c2cb7b223fafb600a619537a871c2818583d619401b785e7c0b746ccde2" dependencies = [ + "base64", + "bs58", + "chrono", + "hex", + "indexmap 1.9.3", "indexmap 2.14.0", - "toml_datetime", - "toml_parser", - "winnow", -] - -[[package]] -name = "toml_parser" -version = "1.1.2+spec-1.1.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "a2abe9b86193656635d2411dc43050282ca48aa31c2451210f4202550afb7526" -dependencies = [ - "winnow", -] - -[[package]] -name = "tracing" -version = "0.1.44" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "63e71662fa4b2a2c3a26f570f037eb95bb1f85397f3cd8076caed2f026a6d100" -dependencies = [ - "log", - "pin-project-lite", - "tracing-attributes", - "tracing-core", + "schemars 0.9.0", + "schemars 1.2.1", + "serde_core", + "serde_json", + "serde_with_macros", + "time", ] [[package]] -name = "tracing-attributes" -version = "0.1.31" +name = "serde_with_macros" +version = "3.20.0" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "7490cfa5ec963746568740651ac6781f701c9c5ea257c58e057f3ba8cf69e8da" +checksum = "b90c488738ecb4fb0262f41f43bc40efc5868d9fb744319ddf5f5317f417bfac" dependencies = [ + "darling", "proc-macro2", "quote", "syn", ] [[package]] -name = "tracing-core" -version = "0.1.36" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "db97caf9d906fbde555dd62fa95ddba9eecfd14cb388e4f491a66d74cd5fb79a" -dependencies = [ - "once_cell", -] - -[[package]] -name = "ttf-parser" -version = "0.25.1" +name = "sha3" +version = "0.10.9" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "d2df906b07856748fa3f6e0ad0cbaa047052d4a7dd609e231c4f72cee8c36f31" +checksum = "77fd7028345d415a4034cf8777cd4f8ab1851274233b45f84e3d955502d93874" dependencies = [ - "core_maths", + "digest", + "keccak", ] [[package]] -name = "typed-arena" -version = "2.0.2" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "6af6ae20167a9ece4bcb41af5b80f8a1f1df981f6391189ce00fd257af04126a" - -[[package]] -name = "typenum" -version = "1.20.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "40ce102ab67701b8526c123c1bab5cbe42d7040ccfd0f64af1a385808d2f43de" - -[[package]] -name = "uds_windows" -version = "1.2.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "f2f6fb2847f6742cd76af783a2a2c49e9375d0a111c7bef6f71cd9e738c72d6e" +name = "shen-cedar-authz" +version = "0.1.0" dependencies = [ - "memoffset", - "tempfile", - "windows-sys 0.61.2", + "cedar-policy", + "shen-rust", ] [[package]] -name = "unicode-bidi" -version = "0.3.18" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "5c1cb5db39152898a79168971543b1cb5020dff7fe43c8dc468b0885f5e29df5" - -[[package]] -name = "unicode-ident" -version = "1.0.24" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "e6e4313cd5fcd3dad5cafa179702e2b244f760991f45397d14d4ebf38247da75" - -[[package]] -name = "unicode-linebreak" -version = "0.1.5" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "3b09c83c3c29d37506a3e260c08c03743a6bb66a9cd432c6934ab501a190571f" - -[[package]] -name = "unicode-normalization" -version = "0.1.25" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "5fd4f6878c9cb28d874b009da9e8d183b5abc80117c40bbd187a1fde336be6e8" +name = "shen-rust" +version = "0.1.0" dependencies = [ - "tinyvec", + "cedar-policy", + "cranelift-codegen", + "cranelift-frontend", + "cranelift-jit", + "cranelift-module", + "cranelift-native", + "smallvec", ] [[package]] -name = "unicode-script" -version = "0.5.8" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "383ad40bb927465ec0ce7720e033cb4ca06912855fc35db31b5755d0de75b1ee" - -[[package]] -name = "unicode-security" -version = "0.1.2" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "2e4ddba1535dd35ed8b61c52166b7155d7f4e4b8847cec6f48e71dc66d8b5e50" +name = "shen-rust-bin" +version = "0.1.0" dependencies = [ - "unicode-normalization", - "unicode-script", + "klcompile", + "shen-rust", ] [[package]] -name = "unicode-segmentation" -version = "1.13.3" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "c6f5d3c3b1bf09027a88a6bc961fc00497d651009560b5463668dc81b0fa87a8" +name = "shenffi" +version = "0.1.0" +dependencies = [ + "shen-rust", +] [[package]] -name = "unicode-width" -version = "0.1.14" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "7dd6e30e90baa6f72411720665d41d89b9a3d039dc45b8faea1ddd07f617f6af" +name = "shengen-rust" +version = "0.1.0" [[package]] -name = "unicode-width" -version = "0.2.2" +name = "shlex" +version = "1.3.0" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "b4ac048d71ede7ee76d585517add45da530660ef4390e49b098733c6e897f254" +checksum = "0fda2ff0d084019ba4d7c6f371c95d8fd75ce3524c3cb8fb653a3023f6323e64" [[package]] -name = "unicode-xid" -version = "0.2.6" +name = "siphasher" +version = "1.0.3" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "ebc1c04c71510c7f702b52b7c350734c9ff1295c464a03335b00bb84fc54f853" +checksum = "8ee5873ec9cce0195efcb7a4e9507a04cd49aec9c83d0389df45b1ef7ba2e649" [[package]] -name = "uuid" -version = "1.23.3" +name = "slab" +version = "0.4.12" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "144d6b123cef80b301b8f72a9e2ca4370ddec21950d0a103dd22c437006d2db7" -dependencies = [ - "js-sys", - "serde_core", - "wasm-bindgen", -] +checksum = "0c790de23124f9ab44544d7ac05d60440adc586479ce501c1d6d7da3cd8c9cf5" [[package]] -name = "version_check" -version = "0.9.5" +name = "smallvec" +version = "1.15.1" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "0b928f33d975fc6ad9f86c8f283853ad26bdd5b10b7f1542aa2fa15e2289105a" +checksum = "67b1b7a3b5fe4f1376887184045fcf45c69e92af734b7aaddc05fb777b6fbd03" [[package]] -name = "walkdir" -version = "2.5.0" +name = "smol_str" +version = "0.3.6" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "29790946404f91d9c5d06f9874efddea1dc06c5efe94541a7d6863108e3a5e4b" +checksum = "4aaa7368fcf4852a4c2dd92df0cace6a71f2091ca0a23391ce7f3a31833f1523" dependencies = [ - "same-file", - "winapi-util", + "borsh", + "serde_core", ] [[package]] -name = "wasip2" -version = "1.0.4+wasi-0.2.12" +name = "stable_deref_trait" +version = "1.2.1" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "b67efb37e106e55ce722a510d6b5f9c17f083e5fc79afc2badeb12cc313d9487" -dependencies = [ - "wit-bindgen", -] +checksum = "6ce2be8dc25455e1f91df71bfa12ad37d7af1092ae736f3a6cd0e37bc7810596" [[package]] -name = "wasm-bindgen" -version = "0.2.122" +name = "stacker" +version = "0.1.24" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "3ed04576f974d2b2fba0f38c51dbc5518011e38c36bf1143164be765528fd409" +checksum = "640c8cdd92b6b12f5bcb1803ca3bbf5ab96e5e6b6b96b9ab77dabe9e880b3190" dependencies = [ + "cc", "cfg-if", - "once_cell", - "rustversion", - "wasm-bindgen-macro", - "wasm-bindgen-shared", + "libc", + "psm", + "windows-sys 0.61.2", ] [[package]] -name = "wasm-bindgen-futures" -version = "0.4.72" +name = "string_cache" +version = "0.8.9" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "9473dbd2991ae90b6291c3c32c30c6187ac49aa32f9905d1cce280ec1e110b0f" +checksum = "bf776ba3fa74f83bf4b63c3dcbbf82173db2632ed8452cb2d891d33f459de70f" dependencies = [ - "js-sys", - "wasm-bindgen", + "new_debug_unreachable", + "parking_lot", + "phf_shared", + "precomputed-hash", ] [[package]] -name = "wasm-bindgen-macro" -version = "0.2.122" +name = "strsim" +version = "0.11.1" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "916151b09da36bd82f6615cbf3a419e2f0ba23a03c6160e8e92eb6bd4aa1dec6" -dependencies = [ - "quote", - "wasm-bindgen-macro-support", -] +checksum = "7da8b5736845d9f2fcb837ea5d9e2628564b3b043a70948a3f0b778838c5fb4f" [[package]] -name = "wasm-bindgen-macro-support" -version = "0.2.122" +name = "syn" +version = "2.0.117" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "299047362ccbfce148b67ab7e73349f77748e00c8296f9542adfad2ad82c5c5e" +checksum = "e665b8803e7b1d2a727f4023456bbbbe74da67099c585258af0ad9c5013b9b99" dependencies = [ - "bumpalo", "proc-macro2", "quote", - "syn", - "wasm-bindgen-shared", -] - -[[package]] -name = "wasm-bindgen-shared" -version = "0.2.122" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "9a929b2c61f11ba3e9bc35b50c1f25cb38e0e892c0c231ae2b8cf78d5dad4437" -dependencies = [ "unicode-ident", ] [[package]] -name = "wasmtime-internal-core" -version = "45.0.0" +name = "target-lexicon" +version = "0.13.5" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "1bdae4b55b15a23d774b15f6e7cd90ae0d0aa17c47c12b4db098b3dd11ba9d58" -dependencies = [ - "hashbrown 0.17.1", - "libm", -] +checksum = "adb6935a6f5c20170eeceb1a3835a49e12e19d792f6dd344ccc76a985ca5a6ca" [[package]] -name = "wasmtime-internal-jit-icache-coherence" -version = "45.0.0" +name = "term" +version = "1.2.1" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "8a312ba8bb77955dcd44294a223e7f124c3071ff966583d385d3f6a4639c62e3" +checksum = "d8c27177b12a6399ffc08b98f76f7c9a1f4fe9fc967c784c5a071fa8d93cf7e1" dependencies = [ - "cfg-if", - "libc", - "wasmtime-internal-core", "windows-sys 0.61.2", ] [[package]] -name = "wasmtimer" -version = "0.4.3" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "1c598d6b99ea013e35844697fc4670d08339d5cda15588f193c6beedd12f644b" -dependencies = [ - "futures", - "js-sys", - "parking_lot", - "pin-utils", - "slab", - "wasm-bindgen", -] - -[[package]] -name = "wayland-backend" -version = "0.3.15" +name = "thiserror" +version = "2.0.18" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "2857dd20b54e916ec7253b3d6b4d5c4d7d4ca2c33c2e11c6c76a99bd8744755d" +checksum = "4288b5bcbc7920c07a1149a35cf9590a2aa808e0bc1eafaade0b80947865fbc4" dependencies = [ - "cc", - "downcast-rs", - "rustix 1.1.4", - "scoped-tls", - "smallvec", - "wayland-sys", + "thiserror-impl", ] [[package]] -name = "wayland-client" -version = "0.31.14" +name = "thiserror-impl" +version = "2.0.18" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "645c7c96bb74690c3189b5c9cb4ca1627062bb23693a4fad9d8c3de958260144" +checksum = "ebc4ee7f67670e9b64d05fa4253e753e016c6c95ff35b89b7941d6b856dec1d5" dependencies = [ - "bitflags 2.11.1", - "rustix 1.1.4", - "wayland-backend", - "wayland-scanner", + "proc-macro2", + "quote", + "syn", ] [[package]] -name = "wayland-csd-frame" -version = "0.3.0" +name = "time" +version = "0.3.47" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "625c5029dbd43d25e6aa9615e88b829a5cad13b2819c4ae129fdbb7c31ab4c7e" +checksum = "743bd48c283afc0388f9b8827b976905fb217ad9e647fae3a379a9283c4def2c" dependencies = [ - "bitflags 2.11.1", - "cursor-icon", - "wayland-backend", + "deranged", + "itoa", + "num-conv", + "powerfmt", + "serde_core", + "time-core", + "time-macros", ] [[package]] -name = "wayland-cursor" -version = "0.31.14" +name = "time-core" +version = "0.1.8" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "4a52d18780be9b1314328a3de5f930b73d2200112e3849ca6cb11822793fb34d" -dependencies = [ - "rustix 1.1.4", - "wayland-client", - "xcursor", -] +checksum = "7694e1cfe791f8d31026952abf09c69ca6f6fa4e1a1229e18988f06a04a12dca" [[package]] -name = "wayland-protocols" -version = "0.32.13" +name = "time-macros" +version = "0.2.27" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "23d0c813de3daa2ed6520af85a3bd49b0e722a3078506899aa9686fea58dc4b6" +checksum = "2e70e4c5a0e0a8a4823ad65dfe1a6930e4f4d756dcd9dd7939022b5e8c501215" dependencies = [ - "bitflags 2.11.1", - "wayland-backend", - "wayland-client", - "wayland-scanner", + "num-conv", + "time-core", ] [[package]] -name = "wayland-protocols-experimental" -version = "20250721.0.1" +name = "tinyvec" +version = "1.11.0" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "40a1f863128dcaaec790d7b4b396cc9b9a7a079e878e18c47e6c2d2c5a8dcbb1" +checksum = "3e61e67053d25a4e82c844e8424039d9745781b3fc4f32b8d55ed50f5f667ef3" dependencies = [ - "bitflags 2.11.1", - "wayland-backend", - "wayland-client", - "wayland-protocols", - "wayland-scanner", + "tinyvec_macros", ] [[package]] -name = "wayland-protocols-misc" -version = "0.3.12" +name = "tinyvec_macros" +version = "0.1.1" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "6e9567599ef23e09b8dad6e429e5738d4509dfc46b3b21f32841a304d16b29c8" -dependencies = [ - "bitflags 2.11.1", - "wayland-backend", - "wayland-client", - "wayland-protocols", - "wayland-scanner", -] +checksum = "1f3ccbac311fea05f86f61904b462b55fb3df8837a366dfc601a0161d0532f20" [[package]] -name = "wayland-protocols-plasma" -version = "0.3.12" +name = "typed-arena" +version = "2.0.2" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "2b6d8cf1eb2c1c31ed1f5643c88a6e53538129d4af80030c8cabd1f9fa884d91" -dependencies = [ - "bitflags 2.11.1", - "wayland-backend", - "wayland-client", - "wayland-protocols", - "wayland-scanner", -] +checksum = "6af6ae20167a9ece4bcb41af5b80f8a1f1df981f6391189ce00fd257af04126a" [[package]] -name = "wayland-protocols-wlr" -version = "0.3.12" +name = "typenum" +version = "1.20.0" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "eb04e52f7836d7c7976c78ca0250d61e33873c34156a2a1fc9474828ec268234" -dependencies = [ - "bitflags 2.11.1", - "wayland-backend", - "wayland-client", - "wayland-protocols", - "wayland-scanner", -] +checksum = "40ce102ab67701b8526c123c1bab5cbe42d7040ccfd0f64af1a385808d2f43de" [[package]] -name = "wayland-scanner" -version = "0.31.10" +name = "unicode-ident" +version = "1.0.24" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "9c324a910fd86ebdc364a3e61ec1f11737d3b1d6c273c0239ee8ff4bc0d24b4a" -dependencies = [ - "proc-macro2", - "quick-xml", - "quote", -] +checksum = "e6e4313cd5fcd3dad5cafa179702e2b244f760991f45397d14d4ebf38247da75" [[package]] -name = "wayland-sys" -version = "0.31.11" +name = "unicode-normalization" +version = "0.1.25" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "d8eab23fefc9e41f8e841df4a9c707e8a8c4ed26e944ef69297184de2785e3be" +checksum = "5fd4f6878c9cb28d874b009da9e8d183b5abc80117c40bbd187a1fde336be6e8" dependencies = [ - "dlib", - "log", - "once_cell", - "pkg-config", + "tinyvec", ] [[package]] -name = "web-sys" -version = "0.3.99" +name = "unicode-script" +version = "0.5.8" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "6d621441cfc37b84979402712047321980c178f299193a3589d05b99e8763436" -dependencies = [ - "js-sys", - "wasm-bindgen", -] +checksum = "383ad40bb927465ec0ce7720e033cb4ca06912855fc35db31b5755d0de75b1ee" [[package]] -name = "web-time" -version = "1.1.0" +name = "unicode-security" +version = "0.1.2" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "5a6580f308b1fad9207618087a65c04e7a10bc77e02c8e84e9b00dd4b12fa0bb" +checksum = "2e4ddba1535dd35ed8b61c52166b7155d7f4e4b8847cec6f48e71dc66d8b5e50" dependencies = [ - "js-sys", - "wasm-bindgen", + "unicode-normalization", + "unicode-script", ] [[package]] -name = "wgpu" -version = "27.0.1" +name = "unicode-width" +version = "0.1.14" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "bfe68bac7cde125de7a731c3400723cadaaf1703795ad3f4805f187459cd7a77" -dependencies = [ - "arrayvec 0.7.7", - "bitflags 2.11.1", - "cfg-if", - "cfg_aliases", - "document-features", - "hashbrown 0.16.1", - "js-sys", - "log", - "naga", - "parking_lot", - "portable-atomic", - "profiling", - "raw-window-handle", - "smallvec", - "static_assertions", - "wasm-bindgen", - "wasm-bindgen-futures", - "web-sys", - "wgpu-core", - "wgpu-hal", - "wgpu-types", -] +checksum = "7dd6e30e90baa6f72411720665d41d89b9a3d039dc45b8faea1ddd07f617f6af" [[package]] -name = "wgpu-core" -version = "27.0.3" +name = "unicode-width" +version = "0.2.2" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "27a75de515543b1897b26119f93731b385a19aea165a1ec5f0e3acecc229cae7" -dependencies = [ - "arrayvec 0.7.7", - "bit-set", - "bit-vec", - "bitflags 2.11.1", - "bytemuck", - "cfg_aliases", - "document-features", - "hashbrown 0.16.1", - "indexmap 2.14.0", - "log", - "naga", - "once_cell", - "parking_lot", - "portable-atomic", - "profiling", - "raw-window-handle", - "rustc-hash 1.1.0", - "smallvec", - "thiserror 2.0.18", - "wgpu-core-deps-apple", - "wgpu-core-deps-emscripten", - "wgpu-core-deps-windows-linux-android", - "wgpu-hal", - "wgpu-types", -] +checksum = "b4ac048d71ede7ee76d585517add45da530660ef4390e49b098733c6e897f254" [[package]] -name = "wgpu-core-deps-apple" -version = "27.0.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "0772ae958e9be0c729561d5e3fd9a19679bcdfb945b8b1a1969d9bfe8056d233" -dependencies = [ - "wgpu-hal", -] +name = "unicode-xid" +version = "0.2.6" +source = "registry+https://github.com/rust-lang/crates.io-index" +checksum = "ebc1c04c71510c7f702b52b7c350734c9ff1295c464a03335b00bb84fc54f853" [[package]] -name = "wgpu-core-deps-emscripten" -version = "27.0.0" +name = "version_check" +version = "0.9.5" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "b06ac3444a95b0813ecfd81ddb2774b66220b264b3e2031152a4a29fda4da6b5" -dependencies = [ - "wgpu-hal", -] +checksum = "0b928f33d975fc6ad9f86c8f283853ad26bdd5b10b7f1542aa2fa15e2289105a" [[package]] -name = "wgpu-core-deps-windows-linux-android" -version = "27.0.0" +name = "walkdir" +version = "2.5.0" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "71197027d61a71748e4120f05a9242b2ad142e3c01f8c1b47707945a879a03c3" +checksum = "29790946404f91d9c5d06f9874efddea1dc06c5efe94541a7d6863108e3a5e4b" dependencies = [ - "wgpu-hal", + "same-file", + "winapi-util", ] [[package]] -name = "wgpu-hal" -version = "27.0.4" +name = "wasm-bindgen" +version = "0.2.122" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "5b21cb61c57ee198bc4aff71aeadff4cbb80b927beb912506af9c780d64313ce" +checksum = "3ed04576f974d2b2fba0f38c51dbc5518011e38c36bf1143164be765528fd409" dependencies = [ - "android_system_properties", - "arrayvec 0.7.7", - "ash", - "bit-set", - "bitflags 2.11.1", - "block", - "bytemuck", "cfg-if", - "cfg_aliases", - "core-graphics-types 0.2.0", - "glow", - "glutin_wgl_sys", - "gpu-alloc", - "gpu-allocator", - "gpu-descriptor", - "hashbrown 0.16.1", - "js-sys", - "khronos-egl", - "libc", - "libloading", - "log", - "metal", - "naga", - "ndk-sys", - "objc", "once_cell", - "ordered-float", - "parking_lot", - "portable-atomic", - "portable-atomic-util", - "profiling", - "range-alloc", - "raw-window-handle", - "renderdoc-sys", - "smallvec", - "thiserror 2.0.18", - "wasm-bindgen", - "web-sys", - "wgpu-types", - "windows 0.58.0", - "windows-core 0.58.0", -] - -[[package]] -name = "wgpu-types" -version = "27.0.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "afdcf84c395990db737f2dd91628706cb31e86d72e53482320d368e52b5da5eb" -dependencies = [ - "bitflags 2.11.1", - "bytemuck", - "js-sys", - "log", - "thiserror 2.0.18", - "web-sys", + "rustversion", + "wasm-bindgen-macro", + "wasm-bindgen-shared", ] [[package]] -name = "winapi-util" -version = "0.1.11" +name = "wasm-bindgen-macro" +version = "0.2.122" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "c2a7b1c03c876122aa43f3020e6c3c3ee5c05081c9a00739faf7503aeba10d22" +checksum = "916151b09da36bd82f6615cbf3a419e2f0ba23a03c6160e8e92eb6bd4aa1dec6" dependencies = [ - "windows-sys 0.61.2", + "quote", + "wasm-bindgen-macro-support", ] [[package]] -name = "window_clipboard" -version = "0.5.1" +name = "wasm-bindgen-macro-support" +version = "0.2.122" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "d5654226305eaf2dde8853fb482861d28e5dcecbbd40cb88e8393d94bb80d733" +checksum = "299047362ccbfce148b67ab7e73349f77748e00c8296f9542adfad2ad82c5c5e" dependencies = [ - "clipboard-win", - "clipboard_macos", - "clipboard_wayland", - "clipboard_x11", - "raw-window-handle", - "thiserror 2.0.18", + "bumpalo", + "proc-macro2", + "quote", + "syn", + "wasm-bindgen-shared", ] [[package]] -name = "windows" -version = "0.58.0" +name = "wasm-bindgen-shared" +version = "0.2.122" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "dd04d41d93c4992d421894c18c8b43496aa748dd4c081bac0dc93eb0489272b6" +checksum = "9a929b2c61f11ba3e9bc35b50c1f25cb38e0e892c0c231ae2b8cf78d5dad4437" dependencies = [ - "windows-core 0.58.0", - "windows-targets", + "unicode-ident", ] [[package]] -name = "windows" -version = "0.62.2" +name = "wasmtime-internal-core" +version = "45.0.0" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "527fadee13e0c05939a6a05d5bd6eec6cd2e3dbd648b9f8e447c6518133d8580" +checksum = "1bdae4b55b15a23d774b15f6e7cd90ae0d0aa17c47c12b4db098b3dd11ba9d58" dependencies = [ - "windows-collections", - "windows-core 0.62.2", - "windows-future", - "windows-numerics", + "hashbrown 0.17.1", + "libm", ] [[package]] -name = "windows-collections" -version = "0.3.2" +name = "wasmtime-internal-jit-icache-coherence" +version = "45.0.0" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "23b2d95af1a8a14a3c7367e1ed4fc9c20e0a26e79551b1454d72583c97cc6610" +checksum = "8a312ba8bb77955dcd44294a223e7f124c3071ff966583d385d3f6a4639c62e3" dependencies = [ - "windows-core 0.62.2", + "cfg-if", + "libc", + "wasmtime-internal-core", + "windows-sys 0.61.2", ] [[package]] -name = "windows-core" -version = "0.58.0" +name = "winapi-util" +version = "0.1.11" source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "6ba6d44ec8c2591c134257ce647b7ea6b20335bf6379a27dac5f1641fcf59f99" +checksum = "c2a7b1c03c876122aa43f3020e6c3c3ee5c05081c9a00739faf7503aeba10d22" dependencies = [ - "windows-implement 0.58.0", - "windows-interface 0.58.0", - "windows-result 0.2.0", - "windows-strings 0.1.0", - "windows-targets", + "windows-sys 0.61.2", ] [[package]] @@ -4629,33 +1654,11 @@ version = "0.62.2" source = "registry+https://github.com/rust-lang/crates.io-index" checksum = "b8e83a14d34d0623b51dce9581199302a221863196a1dde71a7663a4c2be9deb" dependencies = [ - "windows-implement 0.60.2", - "windows-interface 0.59.3", - "windows-link", - "windows-result 0.4.1", - "windows-strings 0.5.1", -] - -[[package]] -name = "windows-future" -version = "0.3.2" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "e1d6f90251fe18a279739e78025bd6ddc52a7e22f921070ccdc67dde84c605cb" -dependencies = [ - "windows-core 0.62.2", + "windows-implement", + "windows-interface", "windows-link", - "windows-threading", -] - -[[package]] -name = "windows-implement" -version = "0.58.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "2bbd5b46c938e506ecbce286b6628a02171d56153ba733b6c741fc627ec9579b" -dependencies = [ - "proc-macro2", - "quote", - "syn", + "windows-result", + "windows-strings", ] [[package]] @@ -4669,17 +1672,6 @@ dependencies = [ "syn", ] -[[package]] -name = "windows-interface" -version = "0.58.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "053c4c462dc91d3b1504c6fe5a726dd15e216ba718e84a0e46a88fbe5ded3515" -dependencies = [ - "proc-macro2", - "quote", - "syn", -] - [[package]] name = "windows-interface" version = "0.59.3" @@ -4697,25 +1689,6 @@ version = "0.2.1" source = "registry+https://github.com/rust-lang/crates.io-index" checksum = "f0805222e57f7521d6a62e36fa9163bc891acd422f971defe97d64e70d0a4fe5" -[[package]] -name = "windows-numerics" -version = "0.3.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "6e2e40844ac143cdb44aead537bbf727de9b044e107a0f1220392177d15b0f26" -dependencies = [ - "windows-core 0.62.2", - "windows-link", -] - -[[package]] -name = "windows-result" -version = "0.2.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "1d1043d8214f791817bab27572aaa8af63732e11bf84aa21a45a78d6c317ae0e" -dependencies = [ - "windows-targets", -] - [[package]] name = "windows-result" version = "0.4.1" @@ -4725,16 +1698,6 @@ dependencies = [ "windows-link", ] -[[package]] -name = "windows-strings" -version = "0.1.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "4cd9b125c486025df0eabcb585e62173c6c9eddcec5d117d3b6e8c30e2ee4d10" -dependencies = [ - "windows-result 0.2.0", - "windows-targets", -] - [[package]] name = "windows-strings" version = "0.5.1" @@ -4778,15 +1741,6 @@ dependencies = [ "windows_x86_64_msvc", ] -[[package]] -name = "windows-threading" -version = "0.2.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "3949bd5b99cafdf1c7ca86b43ca564028dfe27d66958f2470940f73d86d75b37" -dependencies = [ - "windows-link", -] - [[package]] name = "windows_aarch64_gnullvm" version = "0.52.6" @@ -4835,271 +1789,8 @@ version = "0.52.6" source = "registry+https://github.com/rust-lang/crates.io-index" checksum = "589f6da84c646204747d1270a2a5661ea66ed1cced2631d546fdfb155959f9ec" -[[package]] -name = "winit" -version = "0.30.13" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "a6755fa58a9f8350bd1e472d4c3fcc25f824ec358933bba33306d0b63df5978d" -dependencies = [ - "ahash", - "android-activity", - "atomic-waker", - "bitflags 2.11.1", - "block2 0.5.1", - "bytemuck", - "calloop 0.13.0", - "cfg_aliases", - "concurrent-queue", - "core-foundation 0.9.4", - "core-graphics", - "cursor-icon", - "dpi", - "js-sys", - "libc", - "memmap2 0.9.10", - "ndk", - "objc2 0.5.2", - "objc2-app-kit 0.2.2", - "objc2-foundation 0.2.2", - "objc2-ui-kit", - "orbclient", - "percent-encoding", - "pin-project", - "raw-window-handle", - "redox_syscall 0.4.1", - "rustix 0.38.44", - "sctk-adwaita", - "smithay-client-toolkit 0.19.2", - "smol_str 0.2.2", - "tracing", - "unicode-segmentation", - "wasm-bindgen", - "wasm-bindgen-futures", - "wayland-backend", - "wayland-client", - "wayland-protocols", - "wayland-protocols-plasma", - "web-sys", - "web-time", - "windows-sys 0.52.0", - "x11-dl", - "x11rb", - "xkbcommon-dl", -] - -[[package]] -name = "winnow" -version = "1.0.3" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "0592e1c9d151f854e6fd382574c3a0855250e1d9b2f99d9281c6e6391af352f1" -dependencies = [ - "memchr", -] - -[[package]] -name = "wit-bindgen" -version = "0.57.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "1ebf944e87a7c253233ad6766e082e3cd714b5d03812acc24c318f549614536e" - -[[package]] -name = "x11-dl" -version = "2.21.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "38735924fedd5314a6e548792904ed8c6de6636285cb9fec04d5b1db85c1516f" -dependencies = [ - "libc", - "once_cell", - "pkg-config", -] - -[[package]] -name = "x11rb" -version = "0.13.2" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "9993aa5be5a26815fe2c3eacfc1fde061fc1a1f094bf1ad2a18bf9c495dd7414" -dependencies = [ - "as-raw-xcb-connection", - "gethostname", - "libc", - "libloading", - "once_cell", - "rustix 1.1.4", - "x11rb-protocol", -] - -[[package]] -name = "x11rb-protocol" -version = "0.13.2" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "ea6fc2961e4ef194dcbfe56bb845534d0dc8098940c7e5c012a258bfec6701bd" - -[[package]] -name = "xcursor" -version = "0.3.10" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "bec9e4a500ca8864c5b47b8b482a73d62e4237670e5b5f1d6b9e3cae50f28f2b" - -[[package]] -name = "xkbcommon-dl" -version = "0.4.2" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "d039de8032a9a8856a6be89cea3e5d12fdd82306ab7c94d74e6deab2460651c5" -dependencies = [ - "bitflags 2.11.1", - "dlib", - "log", - "once_cell", - "xkeysym", -] - -[[package]] -name = "xkeysym" -version = "0.2.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "b9cc00251562a284751c9973bace760d86c0276c471b4be569fe6b068ee97a56" - -[[package]] -name = "xml-rs" -version = "0.8.28" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "3ae8337f8a065cfc972643663ea4279e04e7256de865aa66fe25cec5fb912d3f" - -[[package]] -name = "yazi" -version = "0.2.1" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "e01738255b5a16e78bbb83e7fbba0a1e7dd506905cfc53f4622d89015a03fbb5" - -[[package]] -name = "zbus" -version = "5.16.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "eee682d202a77e4a9f3b2c2bdf48a7b28af5c08c34ddf66f98c93e5e39464285" -dependencies = [ - "async-broadcast", - "async-executor", - "async-io", - "async-lock", - "async-process", - "async-recursion", - "async-task", - "async-trait", - "blocking", - "enumflags2", - "event-listener", - "futures-core", - "futures-lite", - "hex", - "libc", - "ordered-stream", - "rustix 1.1.4", - "serde", - "serde_repr", - "tracing", - "uds_windows", - "uuid", - "windows-sys 0.61.2", - "winnow", - "zbus_macros", - "zbus_names", - "zvariant", -] - -[[package]] -name = "zbus_macros" -version = "5.16.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "adf1bd45a81a103745b1757754762a26e8cd01e4532e4d6c8ec431624b80d1d6" -dependencies = [ - "proc-macro-crate", - "proc-macro2", - "quote", - "syn", - "zbus_names", - "zvariant", - "zvariant_utils", -] - -[[package]] -name = "zbus_names" -version = "4.3.2" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "7074f3e50b894eac91750142016d30d0a89be8e67dbfd9704fb875825760e52d" -dependencies = [ - "serde", - "winnow", - "zvariant", -] - -[[package]] -name = "zeno" -version = "0.3.3" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "6df3dc4292935e51816d896edcd52aa30bc297907c26167fec31e2b0c6a32524" - -[[package]] -name = "zerocopy" -version = "0.8.52" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "ce1022995ff5ff5d841ad7d994facc23098cd40152f2c1d11cd607c6f530653f" -dependencies = [ - "zerocopy-derive", -] - -[[package]] -name = "zerocopy-derive" -version = "0.8.52" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "1ae7f38b72ec2a254e2b87ef277cf2cd4fb97cbebf944faa6f33354da0867930" -dependencies = [ - "proc-macro2", - "quote", - "syn", -] - [[package]] name = "zmij" version = "1.0.21" source = "registry+https://github.com/rust-lang/crates.io-index" checksum = "b8848ee67ecc8aedbaf3e4122217aff892639231befc6a1b58d29fff4c2cabaa" - -[[package]] -name = "zvariant" -version = "5.12.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "a192a0bde63360d77a7523c833d4b4ce6070a927e2c53246e4c540b1a3e27be0" -dependencies = [ - "endi", - "enumflags2", - "serde", - "winnow", - "zvariant_derive", - "zvariant_utils", -] - -[[package]] -name = "zvariant_derive" -version = "5.12.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "90bc6cde9c01c511074be97f7ccb6c19d0da89e3f8662e812e999dcfd4638737" -dependencies = [ - "proc-macro-crate", - "proc-macro2", - "quote", - "syn", - "zvariant_utils", -] - -[[package]] -name = "zvariant_utils" -version = "3.4.0" -source = "registry+https://github.com/rust-lang/crates.io-index" -checksum = "1e8535915cfa75547e559d8c68e8139909a4aeee076831e4ef7fc59d8172c4d6" -dependencies = [ - "proc-macro2", - "quote", - "serde", - "syn", - "winnow", -] diff --git a/Cargo.toml b/Cargo.toml index 155b727..2085a18 100644 --- a/Cargo.toml +++ b/Cargo.toml @@ -6,7 +6,6 @@ members = [ "crates/klcompile", "crates/ratatoskr-build", "crates/shenffi", - "crates/shencalc-iced", "bin/shen-rust", "examples/shen-cedar-authz", ] diff --git a/crates/shencalc-iced/Cargo.toml b/crates/shencalc-iced/Cargo.toml deleted file mode 100644 index a438a8d..0000000 --- a/crates/shencalc-iced/Cargo.toml +++ /dev/null @@ -1,14 +0,0 @@ -[package] -name = "shencalc-iced" -version.workspace = true -edition.workspace = true -license.workspace = true -description = "ShenCalc — a native cross-platform symbolic calculator GUI (iced) over the shen-cas engine." - -[[bin]] -name = "shencalc-iced" -path = "src/main.rs" - -[dependencies] -shenffi = { path = "../shenffi" } -iced = "0.14" diff --git a/crates/shencalc-iced/src/main.rs b/crates/shencalc-iced/src/main.rs deleted file mode 100644 index 05ca230..0000000 --- a/crates/shencalc-iced/src/main.rs +++ /dev/null @@ -1,288 +0,0 @@ -//! ShenCalc — a native, cross-platform symbolic calculator GUI. -//! -//! Pure Rust: the [iced] UI talks straight to the embedded shen-cas engine -//! (`shenffi::CasEngine`) — no FFI, no Swift, no MLX. This is the Syntax-mode -//! MVP (the user types shen-cas bracket syntax and the CAS reduces it). English -//! mode (a small local model via `candle` that maps NL → the CAS tool grammar) -//! is the planned next layer. -//! -//! The CAS reducer is deeply recursive and tree-walked, so — exactly like -//! `ShenCAS.swift` — both boot and every reduce run on a dedicated worker thread -//! with a large stack (the default 8 MB overflows on boot). The UI thread talks -//! to that worker over channels and stays responsive. - -mod pretty; - -use std::sync::mpsc; -use std::thread; - -use iced::futures::channel::oneshot; -use iced::widget::{button, column, container, row, scrollable, text, text_input}; -use iced::{Element, Length, Task}; -use shenffi::CasEngine; - -/// 64 MB — 4× the ~16 MB the reducer needs at depth, matching ShenCAS.swift. -const WORKER_STACK: usize = 64 * 1024 * 1024; - -fn main() -> iced::Result { - // Headless smoke test of the CAS integration (no display needed), so CI and - // `cargo run -- --selftest` can verify the engine without opening a window. - if std::env::args().any(|a| a == "--selftest") { - run_selftest(); - return Ok(()); - } - - iced::application(ShenCalc::boot, ShenCalc::update, ShenCalc::view) - .title("ShenCalc") - .run() -} - -/// One reduce request handed to the worker thread, with a one-shot reply channel. -struct Job { - input: String, - reply: oneshot::Sender, -} - -#[derive(Debug, Clone)] -enum Message { - /// The worker finished booting the CAS (Ok) or failed (Err message). - Ready(Result<(), String>), - InputChanged(String), - Submit, - /// A reduce finished: the original input plus the rendered result. - Computed(String, String), -} - -struct Entry { - input: String, - result: String, -} - -struct ShenCalc { - input: String, - entries: Vec, - ready: bool, - status: String, - /// Outstanding reduces, so the composer can show "working…". - in_flight: usize, - /// Request channel to the worker; `None` if the worker died at boot. - req_tx: Option>, -} - -impl ShenCalc { - fn boot() -> (Self, Task) { - // Spawn the big-stack worker: it boots the engine, reports readiness on - // `ready_tx`, then serves reduce jobs until the request channel closes. - let (req_tx, req_rx) = mpsc::channel::(); - let (ready_tx, ready_rx) = oneshot::channel::>(); - - thread::Builder::new() - .name("shen-cas".into()) - .stack_size(WORKER_STACK) - .spawn(move || worker(req_rx, ready_tx)) - .expect("spawn shen-cas worker"); - - let state = ShenCalc { - input: String::new(), - entries: Vec::new(), - ready: false, - status: "starting engine…".into(), - in_flight: 0, - req_tx: Some(req_tx), - }; - - // Bridge the readiness one-shot into the iced runtime. - let ready = Task::perform( - async move { - ready_rx - .await - .unwrap_or_else(|_| Err("worker exited".into())) - }, - Message::Ready, - ); - (state, ready) - } - - fn update(&mut self, message: Message) -> Task { - match message { - Message::Ready(Ok(())) => { - self.ready = true; - self.status = "engine ready".into(); - Task::none() - } - Message::Ready(Err(e)) => { - self.status = format!("engine failed: {e}"); - self.req_tx = None; - Task::none() - } - Message::InputChanged(s) => { - self.input = s; - Task::none() - } - Message::Submit => self.submit(), - Message::Computed(input, result) => { - self.in_flight = self.in_flight.saturating_sub(1); - self.entries.push(Entry { input, result }); - Task::none() - } - } - } - - fn submit(&mut self) -> Task { - let input = self.input.trim().to_string(); - let Some(tx) = self.req_tx.clone() else { - return Task::none(); - }; - if input.is_empty() || !self.ready { - return Task::none(); - } - self.input.clear(); - self.in_flight += 1; - - Task::perform( - async move { - let (reply_tx, reply_rx) = oneshot::channel(); - let result = if tx - .send(Job { - input: input.clone(), - reply: reply_tx, - }) - .is_ok() - { - reply_rx - .await - .unwrap_or_else(|_| "error: worker gone".into()) - } else { - "error: engine unavailable".into() - }; - (input, result) - }, - |(input, result)| Message::Computed(input, result), - ) - } - - fn view(&self) -> Element<'_, Message> { - let transcript = if self.entries.is_empty() { - column![text( - "A symbolic calculator powered by the shen-cas engine, in pure \ - Rust. Type shen-cas syntax, e.g. D[Sin[x], x]" - ) - .size(15)] - } else { - self.entries.iter().fold(column![].spacing(14), |col, e| { - let is_error = e.result.starts_with("error:"); - col.push( - column![ - text(e.input.as_str()).size(16).font(iced::Font::MONOSPACE), - row![ - text("= ").size(16), - text(e.result.as_str()) - .size(16) - .font(iced::Font::MONOSPACE) - .color(if is_error { - iced::Color::from_rgb(0.9, 0.35, 0.35) - } else { - iced::Color::from_rgb(0.45, 0.85, 0.72) - }), - ], - ] - .spacing(4), - ) - }) - }; - - let working = self.in_flight > 0; - let composer = row![ - text_input("e.g. D[Sin[x], x]", &self.input) - .on_input(Message::InputChanged) - .on_submit(Message::Submit) - .font(iced::Font::MONOSPACE) - .padding(10), - button(text(if working { "…" } else { "=" })) - .on_press(Message::Submit) - .padding(10), - ] - .spacing(8); - - let header = row![ - text("shen·calc").size(22), - iced::widget::Space::new().width(Length::Fill), - text(self.status.as_str()).size(13).color(if self.ready { - iced::Color::from_rgb(0.45, 0.85, 0.72) - } else { - iced::Color::from_rgb(0.85, 0.6, 0.3) - }), - ] - .spacing(8); - - container( - column![ - header, - scrollable(transcript) - .height(Length::Fill) - .width(Length::Fill), - composer, - ] - .spacing(14), - ) - .padding(18) - .into() - } -} - -/// Worker-thread entry: boot the CAS, signal readiness, then serve reduces. -fn worker(req_rx: mpsc::Receiver, ready_tx: oneshot::Sender>) { - let mut engine = match CasEngine::boot() { - Ok(e) => { - let _ = ready_tx.send(Ok(())); - e - } - Err(e) => { - let _ = ready_tx.send(Err(e)); - return; - } - }; - // `recv` blocks until a job arrives; the loop ends when every Sender drops. - while let Ok(job) = req_rx.recv() { - // Reduce to the raw normal form, then humanise it (cos(x), 3·x²) — the - // same split the Swift apps use (CAS reduce + MathPretty at display). - let result = pretty::render(&engine.reduce(&job.input)); - let _ = job.reply.send(result); - } -} - -/// Headless verification: boot on a big-stack thread and reduce a fixed battery. -fn run_selftest() { - let handle = thread::Builder::new() - .stack_size(WORKER_STACK) - .spawn(|| { - let mut engine = match CasEngine::boot() { - Ok(e) => e, - Err(e) => { - println!("BOOT FAILED: {e}"); - return false; - } - }; - println!("=== ICED SELFTEST START ==="); - let cases = [ - "D[Sin[x], x]", - "Integrate[x^2, x]", - "Factor[x^2 - 1]", - "Solve[x^2 - 4, x]", - "Expand[(x+1)^2]", - "6/4", - "2^10", - ]; - for c in cases { - let raw = engine.reduce(c); - println!("CASE {c} => raw={raw} pretty={}", pretty::render(&raw)); - } - println!("=== ICED SELFTEST DONE ==="); - true - }) - .expect("spawn selftest thread"); - let ok = handle.join().unwrap_or(false); - if !ok { - std::process::exit(1); - } -} diff --git a/crates/shencalc-iced/src/pretty.rs b/crates/shencalc-iced/src/pretty.rs deleted file mode 100644 index e7dfc91..0000000 --- a/crates/shencalc-iced/src/pretty.rs +++ /dev/null @@ -1,351 +0,0 @@ -//! Port of `MathPretty.swift` — renders shen-cas normal-form output (a bracketed -//! S-expression such as `[Times [Power x 2] 3]`) into human-readable math -//! (`3·x²`). Anything it doesn't recognise falls back to function notation -//! (`Head(arg, …)`) rather than leaking raw brackets, and `error:` strings pass -//! through untouched. Kept behaviourally in lock-step with the Swift version so -//! the iced app reads the same as the iOS/macOS apps. - -#[derive(Debug)] -enum Node { - Atom(String), - List(Vec), -} - -/// Precedence context, so we only parenthesise when needed. -#[derive(Clone, Copy, PartialEq)] -enum Ctx { - Top, - Sum, - Product, - Power, - Fn, -} - -/// Render one CAS normal-form string to human-readable math. -pub fn render(cas_output: &str) -> String { - let t = cas_output.trim(); - if t.is_empty() || t.starts_with("error:") { - return cas_output.to_string(); - } - let tokens = tokenize(t); - let mut pos = 0; - match parse(&tokens, &mut pos) { - Some(node) => emit(&node, Ctx::Top), - None => cas_output.to_string(), - } -} - -// MARK: parse - -fn tokenize(s: &str) -> Vec { - let mut out = Vec::new(); - let mut cur = String::new(); - for ch in s.chars() { - match ch { - '[' | ']' => { - if !cur.is_empty() { - out.push(std::mem::take(&mut cur)); - } - out.push(ch.to_string()); - } - ' ' | '\t' | '\n' => { - if !cur.is_empty() { - out.push(std::mem::take(&mut cur)); - } - } - _ => cur.push(ch), - } - } - if !cur.is_empty() { - out.push(cur); - } - out -} - -fn parse(tokens: &[String], pos: &mut usize) -> Option { - let tok = tokens.get(*pos)?.clone(); - *pos += 1; - if tok == "[" { - let mut items = Vec::new(); - while let Some(next) = tokens.get(*pos) { - if next == "]" { - *pos += 1; - break; - } - match parse(tokens, pos) { - Some(n) => items.push(n), - None => break, - } - } - return Some(Node::List(items)); - } - if tok == "]" { - return None; - } - Some(Node::Atom(tok)) -} - -// MARK: emit - -fn emit(node: &Node, parent: Ctx) -> String { - let xs = match node { - Node::Atom(a) => return a.clone(), - Node::List(xs) => xs, - }; - - // Infix binary forms the CAS emits directly, e.g. [3 / 2]. - if xs.len() == 3 { - if let Node::Atom(op) = &xs[1] { - if matches!(op.as_str(), "/" | "+" | "-" | "*" | "^") { - let sep = if op == "/" { - "/".to_string() - } else { - format!(" {op} ") - }; - let s = format!( - "{}{}{}", - emit(&xs[0], Ctx::Product), - sep, - emit(&xs[2], Ctx::Product) - ); - return if op == "/" && parent == Ctx::Power { - format!("({s})") - } else { - s - }; - } - } - } - - let head = match xs.first() { - Some(Node::Atom(h)) => h.as_str(), - _ => return generic(xs), - }; - let args: Vec<&Node> = xs.iter().skip(1).collect(); - let arg0 = |c: Ctx| args.first().map(|a| emit(a, c)).unwrap_or_default(); - - match head { - "Plus" => wrap_if(parent == Ctx::Product || parent == Ctx::Power, sum(&args)), - "Times" => product(&args, parent), - "Power" => power(&args, parent), - "List" => format!( - "{{{}}}", - args.iter() - .map(|a| emit(a, Ctx::Top)) - .collect::>() - .join(", ") - ), - "Exp" => wrap_if(parent == Ctx::Power, format!("e^{}", arg0(Ctx::Power))), - "Log" => format!("ln({})", arg0(Ctx::Fn)), - "Sqrt" => format!("√({})", arg0(Ctx::Fn)), - _ if is_function(head) && args.len() == 1 => { - format!("{}({})", head.to_lowercase(), emit(args[0], Ctx::Fn)) - } - _ => generic(xs), - } -} - -fn is_function(h: &str) -> bool { - matches!( - h, - "Sin" | "Cos" - | "Tan" - | "Sec" - | "Csc" - | "Cot" - | "Sinh" - | "Cosh" - | "Tanh" - | "Arcsin" - | "Arccos" - | "Arctan" - | "Abs" - ) -} - -fn sum(args: &[&Node]) -> String { - let mut result = String::new(); - for (i, term) in args.iter().enumerate() { - let s = emit(term, Ctx::Sum); - if i == 0 { - result = s; - } else if let Some(rest) = s.strip_prefix('-') { - result.push_str(" - "); - result.push_str(rest.trim()); - } else { - result.push_str(" + "); - result.push_str(&s); - } - } - result -} - -fn product(args: &[&Node], parent: Ctx) -> String { - let mut negative = false; - let mut factors: Vec<&Node> = Vec::new(); - for &f in args { - if let Node::Atom(a) = f { - if a == "-1" { - negative = !negative; - continue; - } - } - factors.push(f); - } - // numeric / fraction coefficients first, for natural reading (3·x²). - let mut ordered: Vec<&Node> = Vec::with_capacity(factors.len()); - for &f in &factors { - if is_numeric(f) { - ordered.push(f); - } - } - for &f in &factors { - if !is_numeric(f) { - ordered.push(f); - } - } - let pieces: Vec = ordered - .iter() - .map(|&f| { - let s = emit(f, Ctx::Product); - // bracket fractions used as coefficients: (1/3)·x³ - if let Node::List(l) = f { - if l.len() == 3 { - if let Node::Atom(op) = &l[1] { - if op == "/" { - return format!("({s})"); - } - } - } - } - s - }) - .collect(); - let mut body = if pieces.is_empty() { - "1".to_string() - } else { - pieces.join("·") - }; - if negative { - body = format!("-{body}"); - } - wrap_if(parent == Ctx::Power, body) -} - -fn power(args: &[&Node], parent: Ctx) -> String { - if args.len() != 2 { - let inner = args - .iter() - .map(|a| emit(a, Ctx::Top)) - .collect::>() - .join(", "); - return format!("Power({inner})"); - } - let base_str = emit(args[0], Ctx::Power); - if let Node::Atom(e) = args[1] { - if let Ok(n) = e.parse::() { - if n == 0 { - return "1".to_string(); - } - if n == 1 { - return base_str; - } - if n < 0 { - let denom = if n == -1 { - base_str - } else { - format!("{base_str}{}", superscript(-n)) - }; - return wrap_if(parent == Ctx::Product, format!("1/{denom}")); - } - return format!("{base_str}{}", superscript(n)); - } - } - // non-integer exponent (fraction, symbol): base^(exp) - format!("{base_str}^({})", emit(args[1], Ctx::Power)) -} - -fn is_numeric(n: &Node) -> bool { - match n { - Node::Atom(a) => a.parse::().is_ok(), - // a fraction like [1 / 2] - Node::List(l) => l.len() == 3 && matches!(&l[1], Node::Atom(op) if op == "/"), - } -} - -/// Fallback: render an unrecognised list as Head(arg, …) function notation. -fn generic(xs: &[Node]) -> String { - match xs.first() { - Some(Node::Atom(head)) => { - let args: Vec = xs.iter().skip(1).map(|a| emit(a, Ctx::Top)).collect(); - if args.is_empty() { - head.clone() - } else { - format!("{head}({})", args.join(", ")) - } - } - _ => format!( - "({})", - xs.iter() - .map(|a| emit(a, Ctx::Top)) - .collect::>() - .join(" ") - ), - } -} - -fn wrap_if(cond: bool, s: String) -> String { - if cond { - format!("({s})") - } else { - s - } -} - -fn superscript(n: i64) -> String { - n.to_string() - .chars() - .map(|c| match c { - '0' => '⁰', - '1' => '¹', - '2' => '²', - '3' => '³', - '4' => '⁴', - '5' => '⁵', - '6' => '⁶', - '7' => '⁷', - '8' => '⁸', - '9' => '⁹', - '-' => '⁻', - other => other, - }) - .collect() -} - -#[cfg(test)] -mod tests { - use super::render; - - #[test] - fn matches_swift_mathpretty() { - let cases = [ - ("[Cos x]", "cos(x)"), - ("[Times [Sin x] -1]", "-sin(x)"), - ("[Power [Sec x] 2]", "sec(x)²"), - ("[Times [Power x 2] 3]", "3·x²"), - ("[Times [Power x 3] [1 / 3]]", "(1/3)·x³"), - ("[Plus [Power x 2] [Times x 2] 1]", "x² + 2·x + 1"), - ("[Times [Plus x 1] [Plus x -1]]", "(x + 1)·(x - 1)"), - ("[List 2 -2]", "{2, -2}"), - ("[3 / 2]", "3/2"), - ("1024", "1024"), - ("[Log x]", "ln(x)"), - ("[Power x -1]", "1/x"), - ("[Exp x]", "e^x"), - ("error: bad char .", "error: bad char ."), - ]; - for (input, want) in cases { - assert_eq!(render(input), want, "render({input:?})"); - } - } -} diff --git a/crates/shenffi/README.md b/crates/shenffi/README.md index 51588de..313ba0e 100644 --- a/crates/shenffi/README.md +++ b/crates/shenffi/README.md @@ -57,38 +57,18 @@ desktop, not on a sandboxed device. Two device-friendly options: filesystem dependency. (Exposing that through the C ABI is a small addition; the current `shen_boot` takes a directory path.) -## Embedding a tree-shaken Shen program (shen-cas) - -The `cas/` directory holds a worked example: the **shen-cas computer algebra -system**, tree-shaken by [ratatoskr](../../ratatoskr) and embedded in the binary. - -Pipeline: -1. Flatten shen-cas's modules into one `.shen` (strip its `(load …)` directives). -2. `ratatoskr shake cas-all.shen out/` → `kernel.kl` (only the kernel functions - the CAS reaches — 298 KB vs the 749 KB full kernel) + `cas-all.kl`. -3. `include_str!` both into the crate; `shen_cas_boot` boots the slice via - `boot_from_kl_source` (kernel + `shen.initialise`) then loads the CAS program. -4. `shen_cas_reduce` calls the CAS's own `parse-expr-string → reduce → - pretty-expr` — no Shen-level `eval` required, so eval-stripping is fine. - -```c -ShenCtx *shen_cas_boot(void); -char *shen_cas_reduce(ShenCtx *ctx, const char *expr); // "D[Sin[x],x]" -> "[Cos x]" -``` - -Verified Swift → Rust → CAS results (`swift/cas-demo.swift`): - -``` -D[Sin[x],x] => [Cos x] -D[x^3,x] => [Times [Power x 2] 3] -D[Exp[x],x] => [Exp x] -6/4 => [3 / 2] -``` - -> The CAS reducer is deeply recursive and runs tree-walked, so call the FFI from -> a thread with a large stack (the demo uses a 512 MB `Thread`; the shen-rust CLI -> does the same). This is the same reason an app should call Shen off the main -> thread. +## Embedding a tree-shaken Shen program + +`shen_boot_shaken(kernel_kl, prog_kl)` boots an arbitrary Ratatoskr-shaken slice +— a minimal `kernel.kl` (only the kernel functions the program reaches) plus an +optional program `.kl` — straight from in-memory source, no filesystem access. +This is how an app embeds a specific Shen program without the full kernel. + +For a worked end-to-end example (the **shen-cas** computer-algebra system shaken +by [ratatoskr](../../ratatoskr), wrapped as a `CasEngine` + a `shen_cas_*` C ABI, +and driven from both an iced GUI and SwiftUI), see the **`cas-engine` crate in +the [shen-calc](../../../shen-calc) repo** — the app that consumes it. shenffi +itself stays program-agnostic. ## Status diff --git a/crates/shenffi/build-xcframework.sh b/crates/shenffi/build-xcframework.sh index 02d8630..6aece83 100755 --- a/crates/shenffi/build-xcframework.sh +++ b/crates/shenffi/build-xcframework.sh @@ -4,8 +4,7 @@ # add the bridging header (shenffi.h) + ShenRust.swift, and you're done. # # The macOS slice (aarch64-apple-darwin) lets a native macOS target embed the -# same CAS — and, unlike the iOS simulator, MLX/Metal runs there, so the -# on-device model is exercisable on an Apple-silicon Mac. +# same generic Shen interpreter as the iOS slices. set -euo pipefail cd "$(dirname "$0")/../.." # workspace root (shen-rust/) diff --git a/crates/shenffi/cas/cas-all.kl b/crates/shenffi/cas/cas-all.kl deleted file mode 100644 index 374763c..0000000 --- a/crates/shenffi/cas/cas-all.kl +++ /dev/null @@ -1,1943 +0,0 @@ -(set *intern-table* ()) - -(defun intern-lookup (V3091 V3092) (assoc V3091 V3092)) - -(defun intern-store (V3093 V3094 V3095) (adjoin (cons V3093 (cons V3094 ())) V3095)) - -(defun portable-atom-string (V3096 V3097) (cn (str V3096) (if (symbol? V3097) (str V3097) (str V3097)))) - -(defun hash-atom (V3098 V3099) (hash (portable-atom-string V3098 V3099) 1000000007)) - -(defun hash-compound-args (V3100) (cond ((= () V3100) "") ((cons? V3100) (cn (str (hd V3100)) (hash-compound-args (tl V3100)))) (true (simple-error "partial function hash-compound-args")))) - -(defun hash-compound (V3101 V3102) (hash (cn (str V3101) (hash-compound-args V3102)) 1000000007)) - -(defun alpha-canonicalize (V3103) V3103) - -(defun content-hash* (V3106) (cond ((and (cons? V3106) (and (= sym (hd V3106)) (and (cons? (tl V3106)) (= () (tl (tl V3106)))))) (cons ch (cons (hash-atom "sym" (hd (tl V3106))) ()))) ((symbol? V3106) (cons ch (cons (hash-atom "sym" V3106) ()))) ((and (cons? V3106) (and (= int (hd V3106)) (and (cons? (tl V3106)) (= () (tl (tl V3106)))))) (cons ch (cons (hash-atom "int" (hd (tl V3106))) ()))) ((and (cons? V3106) (and (= rat (hd V3106)) (and (cons? (tl V3106)) (and (cons? (tl (tl V3106))) (= () (tl (tl (tl V3106)))))))) (cons ch (cons (hash (cn "rat" (cn (str (hd (tl V3106))) (cn "/" (str (hd (tl (tl V3106))))))) 1000000007) ()))) ((cons? V3106) (let W3107 (content-hash* (hd V3106)) (let W3108 (canonical-arg-hashes (hd V3106) (tl V3106)) (cons ch (cons (hash-compound (unwrap-ch W3107) (map (lambda Z3109 (unwrap-ch Z3109)) W3108)) ()))))) (true (cons ch (cons (hash-atom "other" 0) ()))))) - -(defun content-hash (V3110) (content-hash* (alpha-canonicalize V3110))) - -(defun unwrap-ch (V3111) (cond ((and (cons? V3111) (and (= ch (hd V3111)) (and (cons? (tl V3111)) (= () (tl (tl V3111)))))) (hd (tl V3111))) (true (simple-error "partial function unwrap-ch")))) - -(defun make-sym (V3112) (cons sym (cons V3112 ()))) - -(defun make-int (V3113) (cons int (cons V3113 ()))) - -(defun make-compound (V3114 V3115) (cons V3114 V3115)) - -(defun cas-intern (V3116) (let W3117 (alpha-canonicalize V3116) (let W3118 (content-hash* W3117) (intern-lookup (unwrap-ch W3118) (value *intern-table*))))) - -(defun cas-intern! (V3119) (let W3120 (alpha-canonicalize V3119) (let W3121 (content-hash* W3120) (let W3122 (unwrap-ch W3121) (let W3123 (intern-lookup W3122 (value *intern-table*)) (if (assoc-hit? W3123) (hd (tl W3123)) (let W3124 W3120 (let W3125 (set *intern-table* (intern-store W3122 W3124 (value *intern-table*))) W3124)))))))) - -(defun content-eq (V3126 V3127) (= (content-hash V3126) (content-hash V3127))) - -(set *structural-sigs* ()) - -(defun assoc-hit? (V3128) (if (cons? V3128) (not (empty? V3128)) false)) - -(defun sig-present? (V3129) (assoc-hit? (assoc V3129 (value *structural-sigs*)))) - -(defun declare-structural-sig (V3130 V3131) (if (sig-present? V3130) (simple-error (cn "structural sig already declared for " (shen.app V3130 "" shen.a))) (do (set *structural-sigs* (cons (cons V3130 V3131) (value *structural-sigs*))) true))) - -(defun get-structural-sig (V3132) (assoc V3132 (value *structural-sigs*))) - -(defun ensure-structural-sig (V3133) (if (sig-present? V3133) true (declare-structural-sig V3133 ()))) - -(defun structural-sig-contains-name? (V3134 V3135) (let W3136 (get-structural-sig V3134) (if (sig-present? V3134) (element? V3135 (map (lambda Z3137 (str Z3137)) (tl W3136))) false))) - -(defun has-flat? (V3138) (structural-sig-contains-name? V3138 "flat")) - -(defun has-orderless? (V3139) (structural-sig-contains-name? V3139 "orderless")) - -(defun sym? (V3140) (cond ((and (cons? V3140) (and (= sym (hd V3140)) (and (cons? (tl V3140)) (and (= () (tl (tl V3140))) (symbol? (hd (tl V3140))))))) true) (true false))) - -(defun sym-name (V3143) (cond ((sym? V3143) (hd (tl V3143))) (true (simple-error "sym-name: not a sym")))) - -(defun headed-by-sym? (V3144 V3145) (and (cons? V3145) (let W3146 (hd V3145) (and (sym? W3146) (= (sym-name W3146) V3144))))) - -(defun canonical-arg-hashes (V3147 V3148) (if (sym? V3147) (let W3149 (sym-name V3147) (let W3150 (if (has-flat? W3149) (flatten-args-for-hash W3149 V3148) (map (lambda Z3151 (content-hash Z3151)) V3148)) (if (has-orderless? W3149) (sort-hashes W3150) W3150))) (map (lambda Z3152 (content-hash Z3152)) V3148))) - -(defun flatten-args-for-hash (V3153 V3154) (cond ((= () V3154) ()) ((cons? V3154) (if (headed-by-sym? V3153 (hd V3154)) (append (flatten-args-for-hash V3153 (tl (hd V3154))) (flatten-args-for-hash V3153 (tl V3154))) (cons (content-hash (hd V3154)) (flatten-args-for-hash V3153 (tl V3154))))) (true (simple-error "partial function flatten-args-for-hash")))) - -(defun sort-hashes (V3155) (sort-hashes-by (lambda Z3156 (lambda Z3157 (<= (unwrap-ch Z3156) (unwrap-ch Z3157)))) V3155)) - -(defun sort-hashes-by (V3160 V3161) (cond ((= () V3161) ()) ((cons? V3161) (insert-by V3160 (hd V3161) (sort-hashes-by V3160 (tl V3161)))) (true (simple-error "partial function sort-hashes-by")))) - -(defun insert-by (V3164 V3165 V3166) (cond ((= () V3166) (cons V3165 ())) ((cons? V3166) (if ((V3164 V3165) (hd V3166)) (cons V3165 V3166) (cons (hd V3166) (insert-by V3164 V3165 (tl V3166))))) (true (simple-error "partial function insert-by")))) - -(set *normal-form-cache* ()) - -(defun nf-cache-key (V3167 V3168) (cons (unwrap-ch V3167) (cons V3168 ()))) - -(defun nf-lookup (V3169) (assoc V3169 (value *normal-form-cache*))) - -(defun nf-store! (V3170 V3171) (set *normal-form-cache* (adjoin (cons V3170 (cons V3171 ())) (value *normal-form-cache*)))) - -(pr "store.shen loaded (Merkle hash + attrs flat/orderless canonical in content-hash path + nf memo). -" (stoutput)) - -(defun sym (V3172) (cas-intern! (make-sym V3172))) - -(defun int (V3173) (cas-intern! (make-int V3173))) - -(defun compound (V3174 V3175) (cas-intern! (make-compound V3174 V3175))) - -(defun pretty-expr (V3176) (cond ((and (cons? V3176) (and (= sym (hd V3176)) (and (cons? (tl V3176)) (= () (tl (tl V3176)))))) (hd (tl V3176))) ((and (cons? V3176) (and (= int (hd V3176)) (and (cons? (tl V3176)) (= () (tl (tl V3176)))))) (hd (tl V3176))) ((and (cons? V3176) (and (= rat (hd V3176)) (and (cons? (tl V3176)) (and (cons? (tl (tl V3176))) (= () (tl (tl (tl V3176)))))))) (cons (hd (tl V3176)) (cons / (tl (tl V3176))))) ((cons? V3176) (cons (pretty-expr (hd V3176)) (map (lambda Z3177 (pretty-expr Z3177)) (tl V3176)))) (true V3176))) - -(pr "expr.shen loaded (datatypes + store constructors). -" (stoutput)) - -(defun blank () (cons (intern "blank") ())) - -(defun blank-seq () (cons (intern "blank-seq") ())) - -(defun blank-null () (cons (intern "blank-null-seq") ())) - -(defun named (V3178 V3179) (cons (intern "named") (cons V3178 (cons V3179 ())))) - -(defun condition (V3180 V3181) (cons (intern "condition") (cons V3180 (cons V3181 ())))) - -(defun ptest (V3182 V3183) (cons (intern "ptest") (cons V3182 (cons V3183 ())))) - -(defun alt (V3184 V3185) (cons (intern "alt") (cons V3184 (cons V3185 ())))) - -(defun blank? (V3186) (and (cons? V3186) (= (hd V3186) (intern "blank")))) - -(defun blank-typed? (V3187) (and (cons? V3187) (and (= (hd V3187) (intern "blank")) (cons? (tl V3187))))) - -(defun named? (V3188) (and (cons? V3188) (and (= (hd V3188) (intern "named")) (= (length V3188) 3)))) - -(defun named-name (V3189) (if (named? V3189) (hd (tl V3189)) (simple-error (cn "named-name: not a named form " (shen.app V3189 "" shen.a))))) - -(defun named-subpattern (V3190) (if (named? V3190) (hd (tl (tl V3190))) (simple-error (cn "named-subpattern: not a named form " (shen.app V3190 "" shen.a))))) - -(defun seq-pattern? (V3191) (or (blank-seq? V3191) (blank-null-seq? V3191))) - -(defun blank-seq? (V3192) (and (cons? V3192) (= (hd V3192) (intern "blank-seq")))) - -(defun blank-null-seq? (V3193) (and (cons? V3193) (= (hd V3193) (intern "blank-null-seq")))) - -(defun condition? (V3194) (and (cons? V3194) (and (= (hd V3194) (intern "condition")) (cons? (tl V3194))))) - -(defun ptest? (V3195) (and (cons? V3195) (and (= (hd V3195) (intern "ptest")) (cons? (tl V3195))))) - -(defun alt? (V3196) (and (cons? V3196) (and (= (hd V3196) (intern "alt")) (cons? (tl V3196))))) - -(defun tagged-pattern-form? (V3199) (or (named? V3199) (or (blank? V3199) (or (blank-typed? V3199) (or (condition? V3199) (or (ptest? V3199) (or (alt? V3199) (seq-pattern? V3199)))))))) - -(defun expr-form? (V3202) (and (cons? V3202) (element? (hd V3202) (cons (intern "sym") (cons (intern "int") (cons (intern "rat") (cons (intern "real") (cons (intern "str") ())))))))) - -(defun compound-pattern? (V3205) (and (cons? V3205) (and (not (tagged-pattern-form? V3205)) (not (expr-form? V3205))))) - -(defun compound-pattern-head (V3206) (if (compound-pattern? V3206) (hd V3206) (simple-error (cn "compound-pattern-head: not " (shen.app V3206 "" shen.a))))) - -(defun compound-pattern-args (V3207) (if (compound-pattern? V3207) (tl V3207) (simple-error (cn "compound-pattern-args: not " (shen.app V3207 "" shen.a))))) - -(defun alt-left (V3208) (if (alt? V3208) (hd (tl V3208)) (simple-error (cn "alt-left " (shen.app V3208 "" shen.a))))) - -(defun alt-right (V3209) (if (alt? V3209) (hd (tl (tl V3209))) (simple-error (cn "alt-right " (shen.app V3209 "" shen.a))))) - -(defun condition-pattern (V3210) (if (condition? V3210) (hd (tl V3210)) (simple-error (cn "condition-pattern " (shen.app V3210 "" shen.a))))) - -(defun ptest-pattern (V3211) (if (ptest? V3211) (hd (tl V3211)) (simple-error (cn "ptest-pattern " (shen.app V3211 "" shen.a))))) - -(defun pattern? (V3212) (or (blank? V3212) (or (blank-typed? V3212) (or (named? V3212) (or (condition? V3212) (or (ptest? V3212) (or (alt? V3212) (or (compound-pattern? V3212) (expr-form? V3212))))))))) - -(defun extract-bindings (V3213) (if (named? V3213) (cons (named-name V3213) (extract-bindings (named-subpattern V3213))) (if (seq-pattern? V3213) () (if (compound-pattern? V3213) (append (extract-bindings (compound-pattern-head V3213)) (mapcan (lambda Z3214 (extract-bindings Z3214)) (compound-pattern-args V3213))) (if (alt? V3213) (append (extract-bindings (alt-left V3213)) (extract-bindings (alt-right V3213))) (if (condition? V3213) (extract-bindings (condition-pattern V3213)) (if (ptest? V3213) (extract-bindings (ptest-pattern V3213)) ()))))))) - -(defun my-remove (V3215 V3216) (if (cons? V3216) (if (= V3215 (hd V3216)) (my-remove V3215 (tl V3216)) (cons (hd V3216) (my-remove V3215 (tl V3216)))) ())) - -(defun dedup (V3217) (if (cons? V3217) (cons (hd V3217) (dedup (my-remove (hd V3217) (tl V3217)))) ())) - -(defun unique-bindings (V3218) (dedup V3218)) - -(defun bindings (V3219) (unique-bindings (extract-bindings V3219))) - -(defun has-bindings? (V3220) (not (empty? (extract-bindings V3220)))) - -(pr "pattern.shen loaded (datatypes + reserved ctors + robust extract-bindings + pattern utilities). -" (stoutput)) - -(set *num-overflow-check* true) - -(defun int64-max () 9223372036854775807) - -(defun int64-min () -9.223372036854776e+18) - -(defun overflow? (V3221) (if (value *num-overflow-check*) (or (>= V3221 (int64-max)) (<= V3221 (int64-min))) false)) - -(defun guard-int (V3222) (if (overflow? V3222) (do (pr (cn "WARNING: int64 overflow in numeric op: " (shen.app V3222 " -" shen.a)) (stoutput)) (simple-error "int64 overflow")) V3222)) - -(defun abs-num (V3223) (if (< V3223 0) (- 0 V3223) V3223)) - -(defun gcd (V3224 V3225) (cond ((= 0 V3225) (abs-num V3224)) (true (gcd V3225 (- V3224 (* (intdiv V3224 V3225) V3225)))))) - -(defun intdiv (V3226 V3227) (let W3228 (round-toward-zero V3226 V3227) W3228)) - -(defun round-toward-zero (V3229 V3230) (let W3231 (/ V3229 V3230) (let W3232 (truncate-float W3231) W3232))) - -(defun truncate-float (V3233) (if (< V3233 0) (- 0 (floor-nonneg (- 0 V3233))) (floor-nonneg V3233))) - -(defun floor-nonneg (V3234) (if (integer? V3234) V3234 (floor-iter V3234 0))) - -(defun floor-iter (V3235 V3236) (if (>= (- V3235 (+ V3236 1)) 0) (floor-iter V3235 (+ V3236 1)) V3236)) - -(defun make-rat (V3241 V3242) (cond ((= 0 V3242) (simple-error "make-rat: zero denominator")) ((= 0 V3241) (cons int (cons 0 ()))) (true (let W3243 (if (< V3242 0) -1 1) (let W3244 (* W3243 V3241) (let W3245 (* W3243 V3242) (let W3246 (gcd (abs-num W3244) (abs-num W3245)) (let W3247 (intdiv W3244 W3246) (let W3248 (intdiv W3245 W3246) (if (= W3248 1) (cons int (cons W3247 ())) (cons rat (cons W3247 (cons W3248 ()))))))))))))) - -(defun as-rat (V3249) (cond ((and (cons? V3249) (and (= int (hd V3249)) (and (cons? (tl V3249)) (= () (tl (tl V3249)))))) (cons (hd (tl V3249)) (cons 1 ()))) ((and (cons? V3249) (and (= rat (hd V3249)) (and (cons? (tl V3249)) (and (cons? (tl (tl V3249))) (= () (tl (tl (tl V3249)))))))) (tl V3249)) (true (simple-error "partial function as-rat")))) - -(defun rat-num (V3252) (cond ((and (cons? V3252) (and (cons? (tl V3252)) (= () (tl (tl V3252))))) (hd V3252)) (true (simple-error "partial function rat-num")))) - -(defun rat-den (V3255) (cond ((and (cons? V3255) (and (cons? (tl V3255)) (= () (tl (tl V3255))))) (hd (tl V3255))) (true (simple-error "partial function rat-den")))) - -(defun num-add (V3256 V3257) (let W3258 (as-rat V3256) (let W3259 (as-rat V3257) (let W3260 (rat-num W3258) (let W3261 (rat-den W3258) (let W3262 (rat-num W3259) (let W3263 (rat-den W3259) (make-rat (guard-int (+ (* W3260 W3263) (* W3262 W3261))) (guard-int (* W3261 W3263)))))))))) - -(defun num-sub (V3264 V3265) (let W3266 (as-rat V3264) (let W3267 (as-rat V3265) (let W3268 (rat-num W3266) (let W3269 (rat-den W3266) (let W3270 (rat-num W3267) (let W3271 (rat-den W3267) (make-rat (guard-int (- (* W3268 W3271) (* W3270 W3269))) (guard-int (* W3269 W3271)))))))))) - -(defun num-mul (V3272 V3273) (let W3274 (as-rat V3272) (let W3275 (as-rat V3273) (let W3276 (rat-num W3274) (let W3277 (rat-den W3274) (let W3278 (rat-num W3275) (let W3279 (rat-den W3275) (make-rat (guard-int (* W3276 W3278)) (guard-int (* W3277 W3279)))))))))) - -(defun num-div (V3280 V3281) (let W3282 (as-rat V3280) (let W3283 (as-rat V3281) (let W3284 (rat-num W3282) (let W3285 (rat-den W3282) (let W3286 (rat-num W3283) (let W3287 (rat-den W3283) (if (= W3286 0) (simple-error "num-div: division by zero") (make-rat (guard-int (* W3284 W3287)) (guard-int (* W3285 W3286))))))))))) - -(defun num-pow (V3288 V3289) (cond ((= 0 V3289) (cons int (cons 1 ()))) (true (if (< V3289 0) (num-div (cons int (cons 1 ())) (num-pow-pos V3288 (- 0 V3289))) (num-pow-pos V3288 V3289))))) - -(defun num-pow-pos (V3290 V3291) (cond ((= 0 V3291) (cons int (cons 1 ()))) (true (num-mul V3290 (num-pow-pos V3290 (- V3291 1)))))) - -(defun numeric? (V3294) (cond ((and (cons? V3294) (and (= int (hd V3294)) (and (cons? (tl V3294)) (= () (tl (tl V3294)))))) (number? (hd (tl V3294)))) ((and (cons? V3294) (and (= rat (hd V3294)) (and (cons? (tl V3294)) (and (cons? (tl (tl V3294))) (= () (tl (tl (tl V3294)))))))) (and (number? (hd (tl V3294))) (number? (hd (tl (tl V3294)))))) (true false))) - -(defun num-eq? (V3295 V3296) (let W3297 (as-rat V3295) (let W3298 (as-rat V3296) (and (= (rat-num W3297) (rat-num W3298)) (= (rat-den W3297) (rat-den W3298)))))) - -(defun all-numeric? (V3299) (cond ((= () V3299) true) ((cons? V3299) (if (numeric? (hd V3299)) (all-numeric? (tl V3299)) false)) (true (simple-error "partial function all-numeric?")))) - -(defun num-builtin (V3300 V3301) (if (all-numeric? V3301) (trap-error (num-apply V3300 V3301) (lambda Z3302 (cons none ()))) (cons none ()))) - -(defun num-apply (V3307 V3308) (cond ((and (cons? V3307) (and (= sym (hd V3307)) (and (cons? (tl V3307)) (= () (tl (tl V3307)))))) (num-apply-by-name (str (hd (tl V3307))) V3308)) (true (cons none ())))) - -(defun num-apply-by-name (V3313 V3314) (cond ((= "Plus" V3313) (cons some (cons (num-sum (cons int (cons 0 ())) V3314) ()))) ((= "Times" V3313) (cons some (cons (num-prod (cons int (cons 1 ())) V3314) ()))) ((and (= "Minus" V3313) (and (cons? V3314) (and (cons? (tl V3314)) (= () (tl (tl V3314)))))) (cons some (cons (num-sub (hd V3314) (hd (tl V3314))) ()))) ((and (= "Divide" V3313) (and (cons? V3314) (and (cons? (tl V3314)) (= () (tl (tl V3314)))))) (num-apply-div (hd V3314) (hd (tl V3314)))) ((and (= "Power" V3313) (and (cons? V3314) (and (cons? (tl V3314)) (and (cons? (hd (tl V3314))) (and (= int (hd (hd (tl V3314)))) (and (cons? (tl (hd (tl V3314)))) (and (= () (tl (tl (hd (tl V3314))))) (= () (tl (tl V3314)))))))))) (num-apply-pow (hd V3314) (hd (tl (hd (tl V3314)))))) (true (cons none ())))) - -(defun num-apply-pow (V3315 V3316) (if (and (num-eq? V3315 (cons int (cons 0 ()))) (= V3316 0)) (cons none ()) (cons some (cons (num-pow V3315 V3316) ())))) - -(defun num-apply-div (V3317 V3318) (if (num-eq? V3318 (cons int (cons 0 ()))) (cons none ()) (cons some (cons (num-div V3317 V3318) ())))) - -(defun num-sum (V3319 V3320) (cond ((= () V3320) V3319) ((cons? V3320) (num-sum (num-add V3319 (hd V3320)) (tl V3320))) (true (simple-error "partial function num-sum")))) - -(defun num-prod (V3321 V3322) (cond ((= () V3322) V3321) ((cons? V3322) (num-prod (num-mul V3321 (hd V3322)) (tl V3322))) (true (simple-error "partial function num-prod")))) - -(pr "num.shen (int + exact rationals + builtin arith) loaded. -" (stoutput)) - -(defun empty-db () ()) - -(defun db-datoms (V3323) V3323) - -(defun filter (V3326 V3327) (cond ((= () V3327) ()) ((cons? V3327) (if (V3326 (hd V3327)) (cons (hd V3327) (filter V3326 (tl V3327))) (filter V3326 (tl V3327)))) (true (simple-error "partial function filter")))) - -(defun basis-token (V3328) (cond ((= () V3328) "[]") ((cons? V3328) (cn "[" (cn (basis-token (hd V3328)) (cn "|" (cn (basis-token (tl V3328)) "]"))))) ((symbol? V3328) (str V3328)) ((number? V3328) (str V3328)) (true (str V3328)))) - -(defun compute-basis (V3329) (cn "basis:" (str (hash (basis-token V3329) 1000000007)))) - -(defun db-basis (V3330) (compute-basis (db-datoms V3330))) - -(defun basis-hash-eq? (V3331 V3332) (= V3331 V3332)) - -(defun make-rule-datum (V3333 V3334) (cons rule (cons V3333 (cons V3334 ())))) - -(defun make-rule-stub (V3335 V3336) (cons rule (cons V3335 (cons V3336 ())))) - -(defun assert-rule (V3337 V3338 V3339 V3340) (append (db-datoms V3337) (cons (cons V3338 (cons V3339 (cons V3340 (cons (length (db-datoms V3337)) ())))) ()))) - -(defun assert-attribute (V3341 V3342 V3343) (append (db-datoms V3341) (cons (cons V3342 (cons V3343 (cons (length (db-datoms V3341)) ()))) ()))) - -(defun rule-datom? (V3344) (and (cons? V3344) (and (= (length V3344) 4) (element? (hd (tl V3344)) (cons own (cons down (cons up ()))))))) - -(defun attr-datom? (V3345) (and (cons? V3345) (= (length V3345) 3))) - -(defun symbol-entry-view (V3346 V3347) (let W3348 (db-datoms V3346) (let W3349 (filter (lambda Z3350 (and (= (hd Z3350) V3347) (rule-datom? Z3350))) W3348) (let W3351 (filter (lambda Z3352 (and (= (hd Z3352) V3347) (attr-datom? Z3352))) W3348) (let W3353 (map (lambda Z3354 (hd (tl (tl Z3354)))) (filter (lambda Z3355 (= (hd (tl Z3355)) own)) W3349)) (let W3356 (map (lambda Z3357 (hd (tl (tl Z3357)))) (filter (lambda Z3358 (= (hd (tl Z3358)) down)) W3349)) (let W3359 (map (lambda Z3360 (hd (tl (tl Z3360)))) (filter (lambda Z3361 (= (hd (tl Z3361)) up)) W3349)) (let W3362 (map (lambda Z3363 (hd (tl Z3363))) W3351) (cons V3347 (cons W3353 (cons W3356 (cons W3359 (cons W3362 ()))))))))))))) - -(defun db-fork (V3364) (db-datoms V3364)) - -(defun db-fork-with (V3365 V3366) (append (db-datoms V3365) V3366)) - -(defun db-size (V3367) (length (db-datoms V3367))) - -(defun db-rule-count (V3368) (length (filter (lambda Z3369 (rule-datom? Z3369)) (db-datoms V3368)))) - -(defun head-attrs (V3370 V3371) (hd (tl (tl (tl (tl (symbol-entry-view V3370 V3371))))))) - -(defun attr-present? (V3372 V3373 V3374) (element? V3374 (head-attrs V3372 V3373))) - -(defun holds-all? (V3375 V3376) (attr-present? V3375 V3376 (intern "hold-all"))) - -(defun holds-first? (V3377 V3378) (attr-present? V3377 V3378 (intern "hold-first"))) - -(defun holds-rest? (V3379 V3380) (attr-present? V3379 V3380 (intern "hold-rest"))) - -(defun listable? (V3381 V3382) (attr-present? V3381 V3382 (intern "listable"))) - -(defun rule (V3383 V3384) (cons rule (cons V3383 (cons V3384 ())))) - -(defun free-symbols (V3387) (cond ((and (cons? V3387) (and (= sym (hd V3387)) (and (cons? (tl V3387)) (= () (tl (tl V3387)))))) (tl V3387)) ((and (cons? V3387) (and (= int (hd V3387)) (and (cons? (tl V3387)) (and (= () (tl (tl V3387))) (number? (hd (tl V3387))))))) ()) ((and (cons? V3387) (and (= rat (hd V3387)) (and (cons? (tl V3387)) (and (cons? (tl (tl V3387))) (and (= () (tl (tl (tl V3387)))) (and (number? (hd (tl V3387))) (number? (hd (tl (tl V3387)))))))))) ()) ((cons? V3387) (append (free-symbols (hd V3387)) (mapcan (lambda Z3388 (free-symbols Z3388)) (tl V3387)))) (true ()))) - -(defun phase1-globals () (cons Plus (cons Times (cons Minus (cons Divide (cons Power (cons If (cons True (cons False (cons List (cons D (cons Integrate (cons Sin (cons Cos (cons Tan (cons Sec (cons Exp (cons Log (cons Sqrt (cons ArcSin (cons ArcCos (cons ArcTan (cons Equal (cons Solve (cons Series (cons Limit (cons Plus (cons Times ())))))))))))))))))))))))))))) - -(defun known-symbol? (V3389) (element? V3389 (phase1-globals))) - -(defun rule-filter (V3392 V3393) (cond ((= () V3393) ()) ((cons? V3393) (if (V3392 (hd V3393)) (cons (hd V3393) (rule-filter V3392 (tl V3393))) (rule-filter V3392 (tl V3393)))) (true (simple-error "partial function rule-filter")))) - -(defun rule-lhs (V3396) (cond ((and (cons? V3396) (and (= rule (hd V3396)) (and (cons? (tl V3396)) (and (cons? (tl (tl V3396))) (= () (tl (tl (tl V3396)))))))) (hd (tl V3396))) (true (simple-error "partial function rule-lhs")))) - -(defun rule-rhs (V3399) (cond ((and (cons? V3399) (and (= rule (hd V3399)) (and (cons? (tl V3399)) (and (cons? (tl (tl V3399))) (= () (tl (tl (tl V3399)))))))) (hd (tl (tl V3399)))) (true (simple-error "partial function rule-rhs")))) - -(defun bindings-cover? (V3400 V3401) (let W3402 (extract-bindings V3400) (let W3403 (free-symbols V3401) (let W3404 (rule-filter (lambda Z3405 (not (or (element? Z3405 W3402) (known-symbol? Z3405)))) W3403) (if (empty? W3404) true (do (pr (cn "bindings-cover? failed unbound: " (shen.app W3404 " -" shen.a)) (stoutput)) false)))))) - -(set *db* (empty-db)) - -(defun lhs-dispatch-pattern (V3406) (if (condition? V3406) (lhs-dispatch-pattern (condition-pattern V3406)) (if (ptest? V3406) (lhs-dispatch-pattern (ptest-pattern V3406)) V3406))) - -(defun rule-head (V3409) (cond ((and (cons? V3409) (and (= rule (hd V3409)) (and (cons? (tl V3409)) (and (cons? (tl (tl V3409))) (= () (tl (tl (tl V3409)))))))) (let W3410 (lhs-dispatch-pattern (hd (tl V3409))) (if (cons? W3410) (hd W3410) W3410))) (true (simple-error "partial function rule-head")))) - -(defun register-rule (V3411) (if (checked-rule? V3411) (if (bindings-cover? (rule-lhs V3411) (rule-rhs V3411)) (let W3412 (rule-head V3411) (let W3413 down (let W3414 (assert-rule (value *db*) W3412 W3413 V3411) (let W3415 (set *db* W3414) (let W3416 (trap-error (warn-on-rule-registration V3411) (lambda Z3417 true)) V3411))))) (simple-error (cn "register-rule: not a checked-rule or bindings not covered " (shen.app V3411 "" shen.a)))) (simple-error (cn "register-rule: not a checked-rule or bindings not covered " (shen.app V3411 "" shen.a))))) - -(defun valid-rule-lhs? (V3418) (let W3419 (lhs-dispatch-pattern V3418) (and (cons? W3419) (sym? (hd W3419))))) - -(defun checked-rule? (V3420) (cond ((and (cons? V3420) (and (= rule (hd V3420)) (and (cons? (tl V3420)) (and (cons? (tl (tl V3420))) (= () (tl (tl (tl V3420)))))))) (valid-rule-lhs? (hd (tl V3420)))) (true false))) - -(pr "rule.shen loaded (checked-rule + bindings-cover). -" (stoutput)) - -(defun structural-attributes () (cons (intern "flat") (cons (intern "orderless") (cons (intern "one-identity") ())))) - -(defun control-attributes () (cons (intern "hold-all") (cons (intern "hold-first") (cons (intern "hold-rest") (cons (intern "listable") ()))))) - -(defun attribute? (V3421) (or (element? V3421 (structural-attributes)) (element? V3421 (control-attributes)))) - -(defun structural-attribute? (V3422) (element? V3422 (structural-attributes))) - -(defun control-attribute? (V3423) (element? V3423 (control-attributes))) - -(defun attr-name? (V3424 V3425) (= (str V3424) V3425)) - -(defun attr-list-has-name? (V3426 V3427) (cond ((= () V3427) false) ((cons? V3427) (if (attr-name? (hd V3427) V3426) true (attr-list-has-name? V3426 (tl V3427)))) (true (simple-error "partial function attr-list-has-name?")))) - -(defun consistent? (V3432 V3433) (cond ((attr-name? V3432 "hold-all") (not (or (attr-list-has-name? "hold-first" V3433) (or (attr-list-has-name? "hold-rest" V3433) (attr-list-has-name? "listable" V3433))))) ((attr-name? V3432 "listable") (not (attr-list-has-name? "hold-all" V3433))) (true true))) - -(defun consistent-attrs? (V3434) (cond ((= () V3434) true) ((cons? V3434) (and (attribute? (hd V3434)) (and (consistent? (hd V3434) (tl V3434)) (consistent-attrs? (tl V3434))))) (true (simple-error "partial function consistent-attrs?")))) - -(defun list? (V3435) (cond ((= () V3435) true) ((cons? V3435) true) (true false))) - -(defun attrs-filter (V3438 V3439) (cond ((= () V3439) ()) ((cons? V3439) (if (V3438 (hd V3439)) (cons (hd V3439) (attrs-filter V3438 (tl V3439))) (attrs-filter V3438 (tl V3439)))) (true (simple-error "partial function attrs-filter")))) - -(defun every (V3442 V3443) (cond ((= () V3443) true) ((cons? V3443) (and (V3442 (hd V3443)) (every V3442 (tl V3443)))) (true (simple-error "partial function every")))) - -(defun valid-attrs? (V3444) (and (list? V3444) (and (every (lambda Z3445 (attribute? Z3445)) V3444) (consistent-attrs? V3444)))) - -(defun register-control-attrs (V3446 V3447) (cond ((= () V3447) V3446) ((cons? V3447) (do (if (control-attribute? (hd V3447)) (set *db* (assert-attribute (value *db*) V3446 (hd V3447))) true) (register-control-attrs V3446 (tl V3447)))) (true (simple-error "partial function register-control-attrs")))) - -(defun declare-symbol (V3448 V3449) (if (not (list? V3449)) (simple-error (cn "declare-symbol: second arg must be a list of attributes, got " (shen.app V3449 "" shen.a))) (if (consistent-attrs? V3449) (let W3450 (attrs-filter (lambda Z3451 (structural-attribute? Z3451)) V3449) (let W3452 (if (empty? W3450) true (declare-structural-sig V3448 W3450)) (let W3453 (register-control-attrs V3448 V3449) (let W3454 (trap-error (warn-on-attribute-declaration V3448) (lambda Z3455 true)) V3448)))) (simple-error (cn "declare-symbol: inconsistent attributes for " (shen.app V3448 (cn ": " (shen.app V3449 " - (rejected combinations: hold-all+hold-{first,rest}, listable+hold-all)" shen.a)) shen.a)))))) - -(defun declare-structural (V3456 V3457) (if (every (lambda Z3458 (structural-attribute? Z3458)) V3457) (declare-symbol V3456 V3457) (simple-error (cn "declare-structural: non-structural attrs supplied for " (shen.app V3456 (cn ": " (shen.app V3457 "" shen.a)) shen.a))))) - -(pr "attrs.shen loaded (structural/control split + consistent? + declare-symbol via store sig). -" (stoutput)) - -(defun my-filter (V3461 V3462) (cond ((= () V3462) ()) ((cons? V3462) (if (V3461 (hd V3462)) (cons (hd V3462) (my-filter V3461 (tl V3462))) (my-filter V3461 (tl V3462)))) (true (simple-error "partial function my-filter")))) - -(defun my-map (V3465 V3466) (cond ((= () V3466) ()) ((cons? V3466) (cons (V3465 (hd V3466)) (my-map V3465 (tl V3466)))) (true (simple-error "partial function my-map")))) - -(defun my-mapcan (V3469 V3470) (cond ((= () V3470) ()) ((cons? V3470) (append (V3469 (hd V3470)) (my-mapcan V3469 (tl V3470)))) (true (simple-error "partial function my-mapcan")))) - -(defun set-member? (V3478 V3479) (cond ((= () V3479) false) ((and (cons? V3479) (= V3478 (hd V3479))) true) ((cons? V3479) (set-member? V3478 (tl V3479))) (true (simple-error "partial function set-member?")))) - -(defun set-adjoin (V3480 V3481) (if (set-member? V3480 V3481) V3481 (cons V3480 V3481))) - -(defun dedup (V3482) (cond ((= () V3482) ()) ((cons? V3482) (set-adjoin (hd V3482) (dedup (tl V3482)))) (true (simple-error "partial function dedup")))) - -(defun set-union (V3483 V3484) (cond ((= () V3483) V3484) ((cons? V3483) (set-union (tl V3483) (set-adjoin (hd V3483) V3484))) (true (simple-error "partial function set-union")))) - -(defun set-subset? (V3487 V3488) (cond ((= () V3487) true) ((cons? V3487) (and (set-member? (hd V3487) V3488) (set-subset? (tl V3487) V3488))) (true (simple-error "partial function set-subset?")))) - -(defun join (V3489 V3490) (dedup (my-mapcan (lambda Z3491 (compose-step Z3491 V3490)) V3489))) - -(defun compose-step (V3496 V3497) (cond ((and (cons? V3496) (and (cons? (tl V3496)) (= () (tl (tl V3496))))) (let W3498 (my-filter (lambda Z3499 (and (cons? Z3499) (= (head Z3499) (hd (tl V3496))))) V3497) (my-map (lambda Z3500 (cons (hd V3496) (cons (head (tail Z3500)) ()))) W3498))) (true ()))) - -(defun lfp (V3501 V3502) (let W3503 (set-union V3501 (V3502 V3501)) (if (set-subset? W3503 V3501) V3501 (lfp W3503 V3502)))) - -(defun reach-step (V3504 V3505) (set-union V3505 (join V3505 V3504))) - -(defun self-edge? (V3509) (cond ((and (cons? V3509) (and (cons? (tl V3509)) (and (= () (tl (tl V3509))) (= (hd V3509) (hd (tl V3509)))))) true) (true false))) - -(defun heads-in-cycles (V3510) (dedup (my-map (lambda Z3511 (head Z3511)) V3510))) - -(defun rule-datom? (V3512) (and (cons? V3512) (and (= (length V3512) 4) (element? (hd (tl V3512)) (cons own (cons down (cons up ()))))))) - -(defun rhs-of-rep (V3515) (cond ((and (cons? V3515) (and (= rule (hd V3515)) (and (cons? (tl V3515)) (and (cons? (tl (tl V3515))) (= () (tl (tl (tl V3515)))))))) (hd (tl (tl V3515)))) (true V3515))) - -(defun head-symbol-from-expr (V3518) (cond ((and (cons? V3518) (and (= sym (hd V3518)) (and (cons? (tl V3518)) (= () (tl (tl V3518)))))) (tl V3518)) ((symbol? V3518) (cons V3518 ())) ((cons? V3518) (append (head-symbol-from-expr (hd V3518)) (my-mapcan (lambda Z3519 (head-symbol-from-expr Z3519)) (tl V3518)))) (true ()))) - -(defun collect-mentioned-heads (V3520) (dedup (head-symbol-from-expr V3520))) - -(defun deps-from-rule-datom (V3521) (let W3522 (hd (tl (tl V3521))) (let W3523 (hd V3521) (let W3524 (rhs-of-rep W3522) (let W3525 (collect-mentioned-heads W3524) (my-map (lambda Z3526 (cons W3523 (cons Z3526 ()))) W3525)))))) - -(defun direct-deps (V3527) (let W3528 (db-datoms V3527) (dedup (my-mapcan (lambda Z3529 (if (rule-datom? Z3529) (deps-from-rule-datom Z3529) ())) W3528)))) - -(defun direct-deps-from-pairs (V3530) (dedup (my-mapcan (lambda Z3531 (let W3532 (head Z3531) (let W3533 (head (tail Z3531)) (my-map (lambda Z3534 (cons W3532 (cons Z3534 ()))) (dedup W3533))))) V3530))) - -(defun rule-dependency-loops (V3535) (let W3536 (direct-deps V3535) (let W3537 (lfp W3536 (lambda Z3538 (reach-step W3536 Z3538))) (heads-in-cycles (my-filter (lambda Z3539 (self-edge? Z3539)) W3537))))) - -(defun rule-dependency-loops-from-edges (V3540) (let W3541 (dedup V3540) (let W3542 (lfp W3541 (lambda Z3543 (reach-step W3541 Z3543))) (heads-in-cycles (my-filter (lambda Z3544 (self-edge? Z3544)) W3542))))) - -(defun reachable-from-edges (V3545) (let W3546 (dedup V3545) (lfp W3546 (lambda Z3547 (reach-step W3546 Z3547))))) - -(set *dispatch-cache* ()) - -(defun dispatch-cache-key (V3548 V3549 V3550) (cons V3548 (cons V3549 (cons V3550 ())))) - -(defun dispatch-lookup (V3551) (assoc V3551 (value *dispatch-cache*))) - -(defun dispatch-cache-hit? (V3552) (if (cons? V3552) (not (empty? V3552)) false)) - -(defun dispatch-store! (V3553 V3554) (set *dispatch-cache* (adjoin (cons V3553 (cons V3554 ())) (value *dispatch-cache*)))) - -(defun expr-head-symbol (V3555) (cond ((and (cons? V3555) (and (cons? (hd V3555)) (and (= sym (hd (hd V3555))) (and (cons? (tl (hd V3555))) (= () (tl (tl (hd V3555)))))))) (hd V3555)) (true (if (cons? V3555) (hd V3555) V3555)))) - -(defun shape-key (V3556) (let W3557 (expr-head-symbol V3556) (let W3558 (if (and (cons? V3556) (cons? (tl V3556))) (length (tl V3556)) 0) (cons W3557 (cons W3558 ()))))) - -(defun compute-cands-for-head (V3559 V3560) (if (not (cons? V3560)) () (let W3561 (symbol-entry-view V3559 V3560) (let W3562 (hd (tl W3561)) (let W3563 (hd (tl (tl W3561))) (let W3564 (hd (tl (tl (tl W3561)))) (append W3562 (append W3563 W3564)))))))) - -(defun dispatch-candidates (V3565 V3566) (let W3567 (db-basis V3565) (let W3568 (expr-head-symbol V3566) (let W3569 (shape-key V3566) (let W3570 (dispatch-cache-key W3567 W3568 W3569) (let W3571 (dispatch-lookup W3570) (if (dispatch-cache-hit? W3571) (hd (tl W3571)) (let W3572 (compute-cands-for-head V3565 W3568) (do (dispatch-store! W3570 W3572) W3572))))))))) - -(defun attr-datom? (V3573) (and (cons? V3573) (= (length V3573) 3))) - -(defun all-heads (V3574) (dedup (my-map (lambda Z3575 (hd Z3575)) (my-filter (lambda Z3576 (rule-datom? Z3576)) (db-datoms V3574))))) - -(defun set-difference (V3577 V3578) (my-filter (lambda Z3579 (not (set-member? Z3579 V3578))) V3577)) - -(defun head-symbol (V3586) (cond ((and (cons? V3586) (and (cons? (hd V3586)) (and (= sym (hd (hd V3586))) (and (cons? (tl (hd V3586))) (= () (tl (tl (hd V3586)))))))) (hd (tl (hd V3586)))) ((and (cons? V3586) (and (= sym (hd V3586)) (and (cons? (tl V3586)) (= () (tl (tl V3586)))))) (hd (tl V3586))) ((cons? V3586) (head-symbol (hd V3586))) ((symbol? V3586) V3586) (true false))) - -(defun covers-patterns? (V3587 V3588) (and (cons? V3587) (and (cons? V3588) (and (((fn equal?) (head-symbol V3587)) (head-symbol V3588)) (>= (length (tl V3587)) (length (tl V3588))))))) - -(defun covers? (V3591) (lambda Z3592 (lambda Z3593 (covers-patterns? Z3592 Z3593)))) - -(defun my-some (V3596 V3597) (cond ((= () V3597) false) ((cons? V3597) (or (V3596 (hd V3597)) (my-some V3596 (tl V3597)))) (true (simple-error "partial function my-some")))) - -(defun unbound-vars (V3598) (let W3599 (all-rule-reps V3598) (my-mapcan (lambda Z3600 (let W3601 (extract-bindings (rule-lhs Z3600)) (let W3602 (free-symbols (rule-rhs Z3600)) (let W3603 (my-filter (lambda Z3604 (not (or (element? Z3604 W3601) (known-symbol? Z3604)))) W3602) (if (empty? W3603) () (cons (cons Z3600 (cons W3603 ())) ())))))) W3599))) - -(defun all-rule-reps (V3605) (my-mapcan (lambda Z3606 (if (rule-datom? Z3606) (cons (hd (tl (tl Z3606))) ()) ())) (db-datoms V3605))) - -(defun symbol-attrs (V3607 V3608) (let W3609 (symbol-entry-view V3607 V3608) (if (cons? W3609) (hd (tl (tl (tl (tl W3609))))) ()))) - -(defun attr-conflicts (V3610) (let W3611 (all-heads V3610) (let W3612 (my-map (lambda Z3613 (hd Z3613)) (my-filter (lambda Z3614 (attr-datom? Z3614)) (db-datoms V3610))) (let W3615 (dedup (append W3611 W3612)) (my-filter (lambda Z3616 (not (consistent-attrs? (symbol-attrs V3610 Z3616)))) W3615))))) - -(defun has-one-identity? (V3617 V3618) (or (structural-sig-contains-name? V3618 "one-identity") (element? (intern "one-identity") (symbol-attrs V3617 V3618)))) - -(defun has-unary-rule? (V3619 V3620) (let W3621 (symbol-entry-view V3619 V3620) (let W3622 (if (cons? W3621) (let W3623 (hd (tl W3621)) (let W3624 (hd (tl (tl W3621))) (let W3625 (if (cons? (tl (tl (tl W3621)))) (hd (tl (tl (tl W3621)))) ()) (append W3623 (append W3624 W3625))))) ()) (my-some (lambda Z3626 (unary-rule-lhs? (rule-lhs Z3626))) W3622)))) - -(defun unary-rule-lhs? (V3627) (and (cons? V3627) (= (length (tl V3627)) 1))) - -(defun oneid-no-unary (V3628) (let W3629 (all-heads V3628) (let W3630 (my-map (lambda Z3631 (hd Z3631)) (my-filter (lambda Z3632 (attr-datom? Z3632)) (db-datoms V3628))) (let W3633 (dedup (append W3629 W3630)) (my-filter (lambda Z3634 (and (has-one-identity? V3628 Z3634) (not (has-unary-rule? V3628 Z3634)))) W3633))))) - -(defun oneid-no-unary-brute (V3635) (let W3636 (my-filter (lambda Z3637 (has-one-identity? V3635 Z3637)) (all-heads V3635)) (let W3638 (my-filter (lambda Z3639 (has-unary-rule? V3635 Z3639)) W3636) (set-difference W3636 W3638)))) - -(defun warn-unbound-in-db (V3640) (let W3641 (unbound-vars V3640) (if (empty? W3641) true (do (pr (cn "WARN [unbound-vars]: rules with potential unbound RHS: " (shen.app W3641 " -" shen.a)) (stoutput)) false)))) - -(defun warn-attr-conflicts (V3642) (let W3643 (attr-conflicts V3642) (if (empty? W3643) true (do (pr (cn "WARN [attr-conflicts]: symbols with inconsistent attrs: " (shen.app W3643 " -" shen.a)) (stoutput)) false)))) - -(defun warn-oneid-no-unary (V3644) (let W3645 (oneid-no-unary V3644) (let W3646 (oneid-no-unary-brute V3644) (do (if (not (empty? W3645)) (pr (cn "WARN [oneid-no-unary]: OneIdentity symbols lacking unary rule: " (shen.app W3645 (cn " (brute: " (shen.app W3646 ") -" shen.a)) shen.a)) (stoutput)) true) (do (if (not (= (length W3645) (length W3646))) (pr (cn "WARN [invariant]: oneid-no-unary vs brute differ: " (shen.app W3645 (cn " vs " (shen.app W3646 " -" shen.a)) shen.a)) (stoutput)) true) (empty? W3645)))))) - -(defun warn-covers-check (V3647) (covers? V3647)) - -(defun run-warns (V3648) (do (warn-unbound-in-db V3648) (do (warn-attr-conflicts V3648) (do (warn-oneid-no-unary V3648) true)))) - -(defun warn-on-rule-registration (V3651) (run-warns (value *db*))) - -(defun warn-on-attribute-declaration (V3654) (run-warns (value *db*))) - -(pr "warn.shen loaded (analysis warnings at reg time: unbound, attr-conflicts, oneid-no-unary). -" (stoutput)) - -(defun match-some (V3655) (cons just (cons V3655 ()))) - -(defun match-none () (cons none ())) - -(defun match-some? (V3656) (if (cons? V3656) (= (hd V3656) just) false)) - -(defun match-unwrap (V3657) (cond ((and (cons? V3657) (and (= just (hd V3657)) (and (cons? (tl V3657)) (= () (tl (tl V3657)))))) (hd (tl V3657))) (true (simple-error "partial function match-unwrap")))) - -(defun merge-bindings (V3658 V3659) (if (bindings-compatible? V3658 V3659) (match-some (append V3658 V3659)) match-none)) - -(defun bindings-compatible? (V3664 V3665) (cond ((= () V3664) true) ((and (cons? V3664) (and (cons? (hd V3664)) (and (cons? (tl (hd V3664))) (= () (tl (tl (hd V3664))))))) (if (binding-conflicts? (hd (hd V3664)) (hd (tl (hd V3664))) V3665) false (bindings-compatible? (tl V3664) V3665))) ((cons? V3664) (bindings-compatible? (tl V3664) V3665)) (true (simple-error "partial function bindings-compatible?")))) - -(defun binding-conflicts? (V3666 V3667 V3668) (let W3669 (assoc V3666 V3668) (if (assoc-hit? W3669) (not (binding-vals-equal? V3667 (hd (tl W3669)))) false))) - -(defun binding-vals-equal? (V3670 V3671) (if (or (seqval? V3670) (seqval? V3671)) (= V3670 V3671) (content-eq V3670 V3671))) - -(defun match (V3684 V3685) (cond ((and (cons? V3684) (and (= blank (hd V3684)) (= () (tl V3684)))) (match-some ())) ((and (cons? V3684) (and (= blank (hd V3684)) (and (cons? (tl V3684)) (and (= () (tl (tl V3684))) (and (cons? V3685) (and (cons? (hd V3685)) (and (= sym (hd (hd V3685))) (and (cons? (tl (hd V3685))) (and (= () (tl (tl (hd V3685)))) (= (hd (tl V3684)) (hd (tl (hd V3685))))))))))))) (match-some ())) ((and (cons? V3684) (and (= blank (hd V3684)) (and (cons? (tl V3684)) (= () (tl (tl V3684)))))) match-none) ((and (cons? V3684) (and (= named (hd V3684)) (and (cons? (tl V3684)) (and (cons? (tl (tl V3684))) (= () (tl (tl (tl V3684)))))))) (let W3686 (match (hd (tl (tl V3684))) V3685) (if (match-some? W3686) (match-some (cons (cons (hd (tl V3684)) (cons V3685 ())) (match-unwrap W3686))) match-none))) ((and (= V3684 V3685) (not (expr-compound? V3685))) (match-some ())) ((and (cons? V3684) (and (= ptest (hd V3684)) (and (cons? (tl V3684)) (and (cons? (tl (tl V3684))) (= () (tl (tl (tl V3684)))))))) (let W3687 (match (hd (tl V3684)) V3685) (if (match-some? W3687) (if (eval-to-true? (normal-form (cons (hd (tl (tl V3684))) (cons V3685 ())))) W3687 match-none) match-none))) ((and (cons? V3684) (and (= condition (hd V3684)) (and (cons? (tl V3684)) (and (cons? (tl (tl V3684))) (= () (tl (tl (tl V3684)))))))) (let W3688 (match (hd (tl V3684)) V3685) (if (match-some? W3688) (if (eval-to-true? (normal-form (substitute (match-unwrap W3688) (hd (tl (tl V3684)))))) W3688 match-none) match-none))) ((and (cons? V3684) (cons? V3685)) (match-compound (hd V3684) (tl V3684) (hd V3685) (tl V3685))) (true match-none))) - -(defun match-compound (V3689 V3690 V3691 V3692) (let W3693 (match V3689 V3691) (if (match-some? W3693) (let W3694 (match-arg-list V3690 V3692) (if (match-some? W3694) (merge-bindings (match-unwrap W3693) (match-unwrap W3694)) match-none)) match-none))) - -(defun match-arg-list (V3699 V3700) (cond ((and (= () V3699) (= () V3700)) (match-some ())) ((and (cons? V3699) (cons? V3700)) (let W3701 (match (hd V3699) (hd V3700)) (if (match-some? W3701) (let W3702 (match-arg-list (tl V3699) (tl V3700)) (if (match-some? W3702) (merge-bindings (match-unwrap W3701) (match-unwrap W3702)) match-none)) match-none))) (true match-none))) - -(defun expr-atom? (V3703) (cond ((and (cons? V3703) (and (= sym (hd V3703)) (and (cons? (tl V3703)) (and (= () (tl (tl V3703))) (symbol? (hd (tl V3703))))))) true) ((and (cons? V3703) (and (= int (hd V3703)) (and (cons? (tl V3703)) (and (= () (tl (tl V3703))) (number? (hd (tl V3703))))))) true) ((and (cons? V3703) (and (= rat (hd V3703)) (and (cons? (tl V3703)) (and (cons? (tl (tl V3703))) (and (= () (tl (tl (tl V3703)))) (and (number? (hd (tl V3703))) (number? (hd (tl (tl V3703)))))))))) true) (true false))) - -(defun expr-compound? (V3706) (cond ((cons? V3706) (and (not (expr-atom? V3706)) (cons? (tl V3706)))) (true false))) - -(defun substitute (V3707 V3708) (cond ((= () V3707) V3708) ((and (cons? V3707) (and (cons? (hd V3707)) (and (cons? (tl (hd V3707))) (= () (tl (tl (hd V3707))))))) (substitute (tl V3707) (replace-free (hd (hd V3707)) (hd (tl (hd V3707))) V3708))) (true (simple-error "partial function substitute")))) - -(defun seqval? (V3709) (and (cons? V3709) (= (hd V3709) (intern "seqval")))) - -(defun seqval-items (V3710) (tl V3710)) - -(defun replace-free (V3712 V3713 V3714) (cond ((and (cons? V3714) (and (= sym (hd V3714)) (and (cons? (tl V3714)) (and (= () (tl (tl V3714))) (= V3712 (hd (tl V3714))))))) V3713) ((and (cons? V3714) (and (= sym (hd V3714)) (and (cons? (tl V3714)) (= () (tl (tl V3714)))))) V3714) ((and (cons? V3714) (and (= int (hd V3714)) (and (cons? (tl V3714)) (= () (tl (tl V3714)))))) V3714) ((and (cons? V3714) (and (= rat (hd V3714)) (and (cons? (tl V3714)) (and (cons? (tl (tl V3714))) (= () (tl (tl (tl V3714)))))))) V3714) ((cons? V3714) (cons (replace-free-head V3712 V3713 (hd V3714)) (replace-free-args V3712 V3713 (tl V3714)))) (true V3714))) - -(defun replace-free-head (V3715 V3716 V3717) (let W3718 (replace-free V3715 V3716 V3717) (if (seqval? W3718) (if (cons? (seqval-items W3718)) (hd (seqval-items W3718)) W3718) W3718))) - -(defun replace-free-args (V3719 V3720 V3721) (cond ((= () V3721) ()) ((cons? V3721) (let W3722 (replace-free V3719 V3720 (hd V3721)) (let W3723 (replace-free-args V3719 V3720 (tl V3721)) (if (seqval? W3722) (append (seqval-items W3722) W3723) (cons W3722 W3723))))) (true (simple-error "partial function replace-free-args")))) - -(defun eval-to-true? (V3726) (cond ((and (cons? V3726) (and (= sym (hd V3726)) (and (cons? (tl V3726)) (and (= () (tl (tl V3726))) (= (hd (tl V3726)) True))))) true) (true false))) - -(pr "match.shen loaded (first-order match + substitute). -" (stoutput)) - -(defun match-arg-list-positional (V3731 V3732) (cond ((and (= () V3731) (= () V3732)) (match-some ())) ((and (cons? V3731) (cons? V3732)) (let W3733 (match (hd V3731) (hd V3732)) (if (match-some? W3733) (let W3734 (match-arg-list-positional (tl V3731) (tl V3732)) (if (match-some? W3734) (merge-bindings (match-unwrap W3733) (match-unwrap W3734)) match-none)) match-none))) (true match-none))) - -(defun seq-pattern-elem? (V3741) (cond ((and (cons? V3741) (and (= blank-seq (hd V3741)) (= () (tl V3741)))) true) ((and (cons? V3741) (and (= blank-null-seq (hd V3741)) (= () (tl V3741)))) true) ((and (cons? V3741) (and (= named (hd V3741)) (and (cons? (tl V3741)) (and (cons? (tl (tl V3741))) (and (cons? (hd (tl (tl V3741)))) (and (= blank-seq (hd (hd (tl (tl V3741))))) (and (= () (tl (hd (tl (tl V3741))))) (= () (tl (tl (tl V3741))))))))))) true) ((and (cons? V3741) (and (= named (hd V3741)) (and (cons? (tl V3741)) (and (cons? (tl (tl V3741))) (and (cons? (hd (tl (tl V3741)))) (and (= blank-null-seq (hd (hd (tl (tl V3741))))) (and (= () (tl (hd (tl (tl V3741))))) (= () (tl (tl (tl V3741))))))))))) true) (true false))) - -(defun has-seq-var? (V3744) (cond ((= () V3744) false) ((cons? V3744) (if (seq-pattern-elem? (hd V3744)) true (has-seq-var? (tl V3744)))) (true false))) - -(defun split (V3745 V3746 V3747 V3748 V3749 V3750 V3751) (let W3752 (if (shen.unlocked? V3749) (let W3753 (shen.lazyderef V3746 V3748) (let W3754 (freeze (do (shen.incinfs) (is! V3745 V3747 V3748 V3749 V3750 V3751))) (if (= W3753 ()) (thaw W3754) (if (shen.pvar? W3753) (shen.bind! W3753 () V3748 W3754) false)))) false) (if (= W3752 false) (if (shen.unlocked? V3749) (let W3755 (shen.lazyderef V3745 V3748) (let W3756 (lambda Z3757 (lambda Z3758 (let W3759 (shen.lazyderef V3746 V3748) (let W3760 (lambda Z3761 (lambda Z3762 (do (shen.incinfs) (is! Z3757 Z3761 V3748 V3749 V3750 (freeze (split Z3758 Z3762 V3747 V3748 V3749 V3750 V3751)))))) (if (cons? W3759) (let W3763 (hd W3759) (let W3764 (tl W3759) ((W3760 W3763) W3764))) (if (shen.pvar? W3759) (let W3765 (shen.newpv V3748) (shen.gc V3748 (let W3766 (shen.newpv V3748) (shen.gc V3748 (shen.bind! W3759 (cons W3765 W3766) V3748 (freeze ((W3760 W3765) W3766))))))) false)))))) (if (cons? W3755) (let W3767 (hd W3755) (let W3768 (tl W3755) ((W3756 W3767) W3768))) (if (shen.pvar? W3755) (let W3769 (shen.newpv V3748) (shen.gc V3748 (let W3770 (shen.newpv V3748) (shen.gc V3748 (shen.bind! W3755 (cons W3769 W3770) V3748 (freeze ((W3756 W3769) W3770))))))) false)))) false) W3752))) - -(defun all-splits (V3771) (all-splits-acc () V3771)) - -(defun all-splits-acc (V3772 V3773) (cons (cons (reverse V3772) (cons V3773 ())) (if (cons? V3773) (all-splits-acc (cons (hd V3773) V3772) (tl V3773)) ()))) - -(defun match-args-with-sequences (V3774 V3775) (seq-match V3774 V3775)) - -(defun seq-match (V3778 V3779) (cond ((and (= () V3778) (= () V3779)) (match-some ())) ((= () V3778) match-none) ((cons? V3778) (if (seq-pattern-elem? (hd V3778)) (seq-match-seqvar (hd V3778) (tl V3778) V3779) (seq-match-normal (hd V3778) (tl V3778) V3779))) (true (simple-error "partial function seq-match")))) - -(defun seq-match-normal (V3784 V3785 V3786) (cond ((= () V3786) match-none) ((cons? V3786) (let W3787 (match V3784 (hd V3786)) (if (match-some? W3787) (let W3788 (seq-match V3785 (tl V3786)) (if (match-some? W3788) (merge-bindings (match-unwrap W3787) (match-unwrap W3788)) match-none)) match-none))) (true (simple-error "partial function seq-match-normal")))) - -(defun seq-match-seqvar (V3789 V3790 V3791) (seq-try-splits V3789 V3790 (seq-valid-splits V3789 V3791))) - -(defun seq-valid-splits (V3792 V3793) (seq-filter-splits (seq-min-one? V3792) (all-splits V3793))) - -(defun seq-min-one? (V3798) (cond ((and (cons? V3798) (and (= blank-seq (hd V3798)) (= () (tl V3798)))) true) ((and (cons? V3798) (and (= named (hd V3798)) (and (cons? (tl V3798)) (and (cons? (tl (tl V3798))) (and (cons? (hd (tl (tl V3798)))) (and (= blank-seq (hd (hd (tl (tl V3798))))) (and (= () (tl (hd (tl (tl V3798))))) (= () (tl (tl (tl V3798))))))))))) true) (true false))) - -(defun seq-filter-splits (V3801 V3802) (cond ((= () V3802) ()) ((and (cons? V3802) (and (cons? (hd V3802)) (and (cons? (tl (hd V3802))) (= () (tl (tl (hd V3802))))))) (if (and V3801 (= (hd (hd V3802)) ())) (seq-filter-splits V3801 (tl V3802)) (cons (hd V3802) (seq-filter-splits V3801 (tl V3802))))) (true (simple-error "partial function seq-filter-splits")))) - -(defun seq-try-splits (V3807 V3808 V3809) (cond ((= () V3809) match-none) ((and (cons? V3809) (and (cons? (hd V3809)) (and (cons? (tl (hd V3809))) (= () (tl (tl (hd V3809))))))) (let W3810 (seq-match V3808 (hd (tl (hd V3809)))) (if (match-some? W3810) (let W3811 (merge-bindings (seq-binding V3807 (hd (hd V3809))) (match-unwrap W3810)) (if (match-some? W3811) W3811 (seq-try-splits V3807 V3808 (tl V3809)))) (seq-try-splits V3807 V3808 (tl V3809))))) (true (simple-error "partial function seq-try-splits")))) - -(defun seq-binding (V3818 V3819) (cond ((and (cons? V3818) (and (= named (hd V3818)) (and (cons? (tl V3818)) (and (cons? (tl (tl V3818))) (= () (tl (tl (tl V3818)))))))) (cons (cons (hd (tl V3818)) (cons (cons (intern "seqval") V3819) ())) ())) (true ()))) - -(defun match-arg-list (V3820 V3821) (cond ((and (= () V3820) (= () V3821)) (match-some ())) (true (if (has-seq-var? V3820) (match-args-with-sequences V3820 V3821) (match-arg-list-positional V3820 V3821))))) - -(pr "match-seq.shen loaded (defprolog split + pure-Shen seq matcher + seq-aware match-arg-list). -" (stoutput)) - -(set *ac-max-args* 8) - -(defun ac-known-heads () (cons (cons sym (cons Plus ())) (cons (cons sym (cons Times ())) (cons Plus (cons Times ()))))) - -(defun is-ac-head? (V3822) (cond ((cons? V3822) (element? V3822 (ac-known-heads))) (true (element? V3822 (ac-known-heads))))) - -(defun ac-head-has-orderless? (V3823) (or (is-ac-head? V3823) (if (sym? V3823) (has-orderless? (sym-name V3823)) false))) - -(defun ac-head-has-flat? (V3824) (or (is-ac-head? V3824) (if (sym? V3824) (has-flat? (sym-name V3824)) false))) - -(defun count-seq-vars (V3825) (cond ((= () V3825) 0) ((and (cons? V3825) (and (cons? (hd V3825)) (and (= blank-seq (hd (hd V3825))) (= () (tl (hd V3825)))))) (+ 1 (count-seq-vars (tl V3825)))) ((and (cons? V3825) (and (cons? (hd V3825)) (and (= blank-null-seq (hd (hd V3825))) (= () (tl (hd V3825)))))) (+ 1 (count-seq-vars (tl V3825)))) ((and (cons? V3825) (and (cons? (hd V3825)) (and (= named (hd (hd V3825))) (and (cons? (tl (hd V3825))) (and (cons? (tl (tl (hd V3825)))) (and (cons? (hd (tl (tl (hd V3825))))) (and (= blank-seq (hd (hd (tl (tl (hd V3825)))))) (and (= () (tl (hd (tl (tl (hd V3825)))))) (= () (tl (tl (tl (hd V3825))))))))))))) (+ 1 (count-seq-vars (tl V3825)))) ((and (cons? V3825) (and (cons? (hd V3825)) (and (= named (hd (hd V3825))) (and (cons? (tl (hd V3825))) (and (cons? (tl (tl (hd V3825)))) (and (cons? (hd (tl (tl (hd V3825))))) (and (= blank-null-seq (hd (hd (tl (tl (hd V3825)))))) (and (= () (tl (hd (tl (tl (hd V3825)))))) (= () (tl (tl (tl (hd V3825))))))))))))) (+ 1 (count-seq-vars (tl V3825)))) ((cons? V3825) (count-seq-vars (tl V3825))) (true (simple-error "partial function count-seq-vars")))) - -(defun count-anchors (V3826) (- (length V3826) (count-seq-vars V3826))) - -(defun ac-blowup-warning (V3827 V3828) (if (and (ac-head-has-flat? V3827) (and (ac-head-has-orderless? V3827) (and (> (count-seq-vars V3828) 1) (= (count-anchors V3828) 0)))) (do (pr (cn "WARNING: AC blowup risk for " (shen.app V3827 " (Flat+Orderless + >1 unanchored seq var) -" shen.a)) (stoutput)) true) true)) - -(defun flatten-flat (V3829 V3830) (cond ((= () V3830) ()) ((cons? V3830) (if (and (sym? V3829) (headed-by-sym? (sym-name V3829) (hd V3830))) (append (flatten-flat V3829 (tl (hd V3830))) (flatten-flat V3829 (tl V3830))) (cons (hd V3830) (flatten-flat V3829 (tl V3830))))) (true (simple-error "partial function flatten-flat")))) - -(defun flatten-flat-args (V3831 V3832) (if (ac-head-has-flat? V3831) (flatten-flat V3831 V3832) V3832)) - -(defun ac-permutations (V3833) (cond ((= () V3833) (cons () ())) (true (ac-perm-insert-each V3833)))) - -(defun ac-perm-insert-each (V3834) (ac-perm-loop V3834 V3834)) - -(defun ac-perm-loop (V3837 V3838) (cond ((= () V3837) ()) ((cons? V3837) (append (ac-prepend-all (hd V3837) (ac-permutations (ac-remove-first (hd V3837) V3838))) (ac-perm-loop (tl V3837) V3838))) (true (simple-error "partial function ac-perm-loop")))) - -(defun ac-prepend-all (V3841 V3842) (cond ((= () V3842) ()) ((cons? V3842) (cons (cons V3841 (hd V3842)) (ac-prepend-all V3841 (tl V3842)))) (true (simple-error "partial function ac-prepend-all")))) - -(defun ac-remove-first (V3845 V3846) (cond ((= () V3846) ()) ((cons? V3846) (if (= V3845 (hd V3846)) (tl V3846) (cons (hd V3846) (ac-remove-first V3845 (tl V3846))))) (true (simple-error "partial function ac-remove-first")))) - -(defun match-orderless (V3847 V3848 V3849) (if (> (length V3849) (value *ac-max-args*)) (do (pr (cn "WARNING: AC permutation search skipped for " (shen.app V3847 (cn " (>" (shen.app (value *ac-max-args*) " args) -" shen.a)) shen.a)) (stoutput)) (match-arg-list V3848 V3849)) (let W3850 (ac-permutations V3849) (if (needs-self-binding-score? V3848 V3849) (match-orderless-best V3848 W3850 match-none -1 (self-binding-candidate-count V3848 V3849)) (match-orderless-perms V3848 W3850))))) - -(defun match-orderless-perms (V3853 V3854) (cond ((= () V3854) match-none) ((cons? V3854) (let W3855 (match-arg-list V3853 (hd V3854)) (if (match-some? W3855) W3855 (match-orderless-perms V3853 (tl V3854))))) (true (simple-error "partial function match-orderless-perms")))) - -(defun match-orderless-best (V3862 V3863 V3864 V3865 V3866) (cond ((= () V3863) V3864) ((cons? V3863) (let W3867 (match-arg-list V3862 (hd V3863)) (if (match-some? W3867) (let W3868 (binding-list-score (match-unwrap W3867)) (if (> W3868 V3865) (if (= W3868 V3866) W3867 (match-orderless-best V3862 (tl V3863) W3867 W3868 V3866)) (match-orderless-best V3862 (tl V3863) V3864 V3865 V3866))) (match-orderless-best V3862 (tl V3863) V3864 V3865 V3866)))) (true (simple-error "partial function match-orderless-best")))) - -(defun binding-list-score (V3872) (cond ((= () V3872) 0) ((and (cons? V3872) (and (cons? (hd V3872)) (and (cons? (tl (hd V3872))) (and (cons? (hd (tl (hd V3872)))) (and (= sym (hd (hd (tl (hd V3872))))) (and (cons? (tl (hd (tl (hd V3872))))) (and (= () (tl (tl (hd (tl (hd V3872)))))) (and (= () (tl (tl (hd V3872)))) (= (hd (hd V3872)) (hd (tl (hd (tl (hd V3872)))))))))))))) (+ 1 (binding-list-score (tl V3872)))) ((cons? V3872) (binding-list-score (tl V3872))) (true (simple-error "partial function binding-list-score")))) - -(defun needs-self-binding-score? (V3873 V3874) (and (<= (length V3874) 2) (has-self-binding-candidate? V3873 V3874))) - -(defun has-self-binding-candidate? (V3879 V3880) (cond ((= () V3879) false) ((and (cons? V3879) (and (cons? (hd V3879)) (and (= named (hd (hd V3879))) (and (cons? (tl (hd V3879))) (and (cons? (tl (tl (hd V3879)))) (and (cons? (hd (tl (tl (hd V3879))))) (and (= blank (hd (hd (tl (tl (hd V3879)))))) (and (= () (tl (hd (tl (tl (hd V3879)))))) (= () (tl (tl (tl (hd V3879))))))))))))) (if (expr-list-contains-sym? (hd (tl (hd V3879))) V3880) true (has-self-binding-candidate? (tl V3879) V3880))) ((cons? V3879) (has-self-binding-candidate? (tl V3879) V3880)) (true (simple-error "partial function has-self-binding-candidate?")))) - -(defun self-binding-candidate-count (V3885 V3886) (cond ((= () V3885) 0) ((and (cons? V3885) (and (cons? (hd V3885)) (and (= named (hd (hd V3885))) (and (cons? (tl (hd V3885))) (and (cons? (tl (tl (hd V3885)))) (and (cons? (hd (tl (tl (hd V3885))))) (and (= blank (hd (hd (tl (tl (hd V3885)))))) (and (= () (tl (hd (tl (tl (hd V3885)))))) (= () (tl (tl (tl (hd V3885))))))))))))) (if (expr-list-contains-sym? (hd (tl (hd V3885))) V3886) (+ 1 (self-binding-candidate-count (tl V3885) V3886)) (self-binding-candidate-count (tl V3885) V3886))) ((cons? V3885) (self-binding-candidate-count (tl V3885) V3886)) (true (simple-error "partial function self-binding-candidate-count")))) - -(defun expr-list-contains-sym? (V3894 V3895) (cond ((= () V3895) false) ((and (cons? V3895) (and (cons? (hd V3895)) (and (= sym (hd (hd V3895))) (and (cons? (tl (hd V3895))) (and (= () (tl (tl (hd V3895)))) (= V3894 (hd (tl (hd V3895))))))))) true) ((cons? V3895) (expr-list-contains-sym? V3894 (tl V3895))) (true (simple-error "partial function expr-list-contains-sym?")))) - -(defun match-compound (V3896 V3897 V3898 V3899) (let W3900 (match V3896 V3898) (if (match-some? W3900) (let W3901 (if (cons? V3898) (flatten-flat-args V3898 V3899) V3899) (let W3902 (if (cons? V3898) (ac-blowup-warning V3898 V3897) true) (let W3903 (if (and (cons? V3898) (ac-head-has-orderless? V3898)) (match-orderless V3898 V3897 W3901) (match-arg-list V3897 W3901)) (if (match-some? W3903) (merge-bindings (match-unwrap W3900) (match-unwrap W3903)) match-none)))) match-none))) - -(pr "match-ac.shen loaded (orderless perm any-seq-count + flat nested flatten + blowup warning). -" (stoutput)) - -(defun calc-true () (cons sym (cons True ()))) - -(defun calc-false () (cons sym (cons False ()))) - -(defun bool->expr (V3904) (cond ((= true V3904) (calc-true)) ((= false V3904) (calc-false)) (true (simple-error "partial function bool->expr")))) - -(defun occurs-in? (V3908 V3909) (cond ((= V3908 V3909) true) ((and (cons? V3909) (and (= sym (hd V3909)) (and (cons? (tl V3909)) (= () (tl (tl V3909)))))) false) ((and (cons? V3909) (and (= int (hd V3909)) (and (cons? (tl V3909)) (= () (tl (tl V3909)))))) false) ((and (cons? V3909) (and (= rat (hd V3909)) (and (cons? (tl V3909)) (and (cons? (tl (tl V3909))) (= () (tl (tl (tl V3909)))))))) false) ((cons? V3909) (if (occurs-in? V3908 (hd V3909)) true (occurs-in-list? V3908 (tl V3909)))) (true false))) - -(defun occurs-in-list? (V3910 V3911) (cond ((= () V3911) false) ((cons? V3911) (if (occurs-in? V3910 (hd V3911)) true (occurs-in-list? V3910 (tl V3911)))) (true (simple-error "partial function occurs-in-list?")))) - -(defun free-of? (V3912 V3913) (not (occurs-in? V3913 V3912))) - -(defun number-expr? (V3916) (cond ((and (cons? V3916) (and (= int (hd V3916)) (and (cons? (tl V3916)) (= () (tl (tl V3916)))))) (number? (hd (tl V3916)))) ((and (cons? V3916) (and (= rat (hd V3916)) (and (cons? (tl V3916)) (and (cons? (tl (tl V3916))) (= () (tl (tl (tl V3916)))))))) (and (number? (hd (tl V3916))) (number? (hd (tl (tl V3916)))))) (true false))) - -(defun calc-builtin (V3921 V3922) (cond ((and (cons? V3921) (and (= sym (hd V3921)) (and (cons? (tl V3921)) (= () (tl (tl V3921)))))) (calc-by-name (str (hd (tl V3921))) V3922)) (true (cons none ())))) - -(defun positive-expr? (V3925) (cond ((and (cons? V3925) (and (= int (hd V3925)) (and (cons? (tl V3925)) (and (= () (tl (tl V3925))) (number? (hd (tl V3925))))))) (> (hd (tl V3925)) 0)) ((and (cons? V3925) (and (= rat (hd V3925)) (and (cons? (tl V3925)) (and (cons? (tl (tl V3925))) (and (= () (tl (tl (tl V3925)))) (and (number? (hd (tl V3925))) (number? (hd (tl (tl V3925)))))))))) (> (hd (tl V3925)) 0)) (true false))) - -(defun calc-by-name (V3930 V3931) (cond ((and (= "SameQ" V3930) (and (cons? V3931) (and (cons? (tl V3931)) (= () (tl (tl V3931)))))) (cons some (cons (bool->expr (content-eq (hd V3931) (hd (tl V3931)))) ()))) ((and (= "UnsameQ" V3930) (and (cons? V3931) (and (cons? (tl V3931)) (= () (tl (tl V3931)))))) (cons some (cons (bool->expr (not (content-eq (hd V3931) (hd (tl V3931))))) ()))) ((and (= "FreeQ" V3930) (and (cons? V3931) (and (cons? (tl V3931)) (= () (tl (tl V3931)))))) (cons some (cons (bool->expr (free-of? (hd V3931) (hd (tl V3931)))) ()))) ((and (= "NumberQ" V3930) (and (cons? V3931) (= () (tl V3931)))) (cons some (cons (bool->expr (number-expr? (hd V3931))) ()))) ((and (= "Positive" V3930) (and (cons? V3931) (= () (tl V3931)))) (cons some (cons (bool->expr (positive-expr? (hd V3931))) ()))) ((= "And" V3930) (cons some (cons (bool->expr (all-true? V3931)) ()))) ((and (= "Simplify" V3930) (and (cons? V3931) (= () (tl V3931)))) (cons some (cons (collect-like-terms (hd V3931)) ()))) ((and (= "Expand" V3930) (and (cons? V3931) (= () (tl V3931)))) (cons some (cons (poly-expand (hd V3931)) ()))) ((and (= "PolynomialQ" V3930) (and (cons? V3931) (and (cons? (tl V3931)) (= () (tl (tl V3931)))))) (cons some (cons (bool->expr (polynomial-q? (hd V3931) (hd (tl V3931)))) ()))) ((and (= "PolynomialGCD" V3930) (and (cons? V3931) (and (cons? (tl V3931)) (= () (tl (tl V3931)))))) (poly-gcd-builtin (hd V3931) (hd (tl V3931)))) ((and (= "Cancel" V3930) (and (cons? V3931) (= () (tl V3931)))) (cancel-builtin (hd V3931))) ((and (= "Together" V3930) (and (cons? V3931) (= () (tl V3931)))) (together-builtin (hd V3931))) ((and (= "Factor" V3930) (and (cons? V3931) (= () (tl V3931)))) (factor-builtin (hd V3931))) ((and (= "Apart" V3930) (and (cons? V3931) (= () (tl V3931)))) (apart-builtin (hd V3931))) ((and (= "Solve" V3930) (and (cons? V3931) (and (cons? (tl V3931)) (= () (tl (tl V3931)))))) (solve-builtin (hd V3931) (hd (tl V3931)))) ((and (= "Integrate" V3930) (and (cons? V3931) (and (cons? (tl V3931)) (= () (tl (tl V3931)))))) (integrate-wired (hd V3931) (hd (tl V3931)))) ((= "Series" V3930) (series-builtin V3931)) ((= "Limit" V3930) (limit-builtin V3931)) (true (cons none ())))) - -(defun integrate-wired (V3932 V3933) (let W3934 (integrate-pullout V3932 V3933) (if (= W3934 (cons none ())) (integrate-after-pullout V3932 V3933) W3934))) - -(defun integrate-after-pullout (V3935 V3936) (let W3937 (integrate-linear-usub V3935 V3936) (if (= W3937 (cons none ())) (integrate-after-usub V3935 V3936) W3937))) - -(defun integrate-after-usub (V3938 V3939) (let W3940 (integrate-table V3938 V3939) (if (= W3940 (cons none ())) (integrate-after-table V3938 V3939) W3940))) - -(defun integrate-after-table (V3941 V3942) (let W3943 (integrate-invfun V3941 V3942) (if (= W3943 (cons none ())) (integrate-after-invfun V3941 V3942) W3943))) - -(defun integrate-after-invfun (V3944 V3945) (let W3946 (integrate-log-parts V3944 V3945) (if (= W3946 (cons none ())) (integrate-after-log V3944 V3945) W3946))) - -(defun integrate-after-log (V3947 V3948) (let W3949 (integrate-cyclic V3947 V3948) (if (= W3949 (cons none ())) (integrate-after-cyclic V3947 V3948) W3949))) - -(defun integrate-after-cyclic (V3950 V3951) (let W3952 (integrate-trigpow V3950 V3951) (if (= W3952 (cons none ())) (integrate-after-trigpow V3950 V3951) W3952))) - -(defun integrate-after-trigpow (V3953 V3954) (let W3955 (integrate-sincos V3953 V3954) (if (= W3955 (cons none ())) (integrate-after-sincos V3953 V3954) W3955))) - -(defun integrate-after-sincos (V3956 V3957) (let W3958 (integrate-powusub V3956 V3957) (if (= W3958 (cons none ())) (integrate-after-powusub V3956 V3957) W3958))) - -(defun integrate-after-powusub (V3959 V3960) (let W3961 (integrate-arcsin V3959 V3960) (if (= W3961 (cons none ())) (integrate-by-parts V3959 V3960) W3961))) - -(defun integrate-table (V3966 V3967) (cond ((and (cons? V3966) (and (cons? (hd V3966)) (and (= sym (hd (hd V3966))) (and (cons? (tl (hd V3966))) (and (= () (tl (tl (hd V3966)))) (and (cons? (tl V3966)) (and (cons? (tl (tl V3966))) (= () (tl (tl (tl V3966))))))))))) (itable-divide (str (hd (tl (hd V3966)))) (hd (tl V3966)) (hd (tl (tl V3966))) V3967)) (true (cons none ())))) - -(defun itable-divide (V3976 V3977 V3978 V3979) (cond ((= "Divide" V3976) (itable-on-divide V3977 V3978 V3979)) (true (cons none ())))) - -(defun itable-on-divide (V3980 V3981 V3982) (cond ((and (cons? V3980) (and (= int (hd V3980)) (and (cons? (tl V3980)) (and (= 1 (hd (tl V3980))) (= () (tl (tl V3980))))))) (itable-recip V3981 V3982 (expr->coeffs V3982 V3981))) (true (itable-logderiv V3980 V3981 V3982)))) - -(defun itable-recip (V3985 V3986 V3987) (cond ((and (cons? V3987) (and (= some (hd V3987)) (and (cons? (tl V3987)) (and (cons? (hd (tl V3987))) (and (cons? (tl (hd (tl V3987)))) (and (cons? (tl (tl (hd (tl V3987))))) (and (= () (tl (tl (tl (hd (tl V3987)))))) (= () (tl (tl V3987)))))))))) (if (one-zero-one? (hd (hd (tl V3987))) (hd (tl (hd (tl V3987)))) (hd (tl (tl (hd (tl V3987)))))) (cons some (cons (cons (cons sym (cons ArcTan ())) (cons V3986 ())) ())) (cons none ()))) ((and (cons? V3987) (and (= some (hd V3987)) (and (cons? (tl V3987)) (and (cons? (hd (tl V3987))) (and (cons? (tl (hd (tl V3987)))) (and (= () (tl (tl (hd (tl V3987))))) (= () (tl (tl V3987))))))))) (cons some (cons (cons (ct-times) (cons (cons (ct-power) (cons (hd (tl (hd (tl V3987)))) (cons (cons int (cons -1 ())) ()))) (cons (cons (cons sym (cons Log ())) (cons V3985 ())) ()))) ()))) (true (cons none ())))) - -(defun one-zero-one? (V3988 V3989 V3990) (if (content-eq V3988 (cons int (cons 1 ()))) (if (content-eq V3989 (cons int (cons 0 ()))) (content-eq V3990 (cons int (cons 1 ()))) false) false)) - -(defun itable-logderiv (V3991 V3992 V3993) (itable-logderiv-2 V3991 V3992 V3993 (expr->coeffs V3993 V3991) (expr->coeffs V3993 (reduce (cons (cons sym (cons D ())) (cons V3992 (cons V3993 ()))))))) - -(defun itable-logderiv-2 (V3998 V3999 V4000 V4001 V4002) (cond ((and (cons? V4001) (and (= some (hd V4001)) (and (cons? (tl V4001)) (and (= () (tl (tl V4001))) (and (cons? V4002) (and (= some (hd V4002)) (and (cons? (tl V4002)) (= () (tl (tl V4002)))))))))) (itable-logderiv-3 V3999 (vec-ratio (hd (tl V4001)) (hd (tl V4002))))) (true (cons none ())))) - -(defun itable-logderiv-3 (V4005 V4006) (cond ((and (cons? V4006) (and (= some (hd V4006)) (and (cons? (tl V4006)) (= () (tl (tl V4006)))))) (cons some (cons (cons (ct-times) (cons (hd (tl V4006)) (cons (cons (cons sym (cons Log ())) (cons V4005 ())) ()))) ()))) (true (cons none ())))) - -(defun vec-ratio (V4007 V4008) (if (= (length V4007) (length V4008)) (vr-check-ratio V4007 V4008 (num-div (vr-last V4007) (vr-last V4008))) (cons none ()))) - -(defun vr-last (V4011) (cond ((and (cons? V4011) (= () (tl V4011))) (hd V4011)) ((cons? V4011) (vr-last (tl V4011))) (true (simple-error "partial function vr-last")))) - -(defun vr-check-ratio (V4012 V4013 V4014) (if (vr-elementwise? V4012 V4013 V4014) (cons some (cons V4014 ())) (cons none ()))) - -(defun vr-elementwise? (V4023 V4024 V4025) (cond ((and (= () V4023) (= () V4024)) true) ((and (cons? V4023) (cons? V4024)) (if (num-eq? (hd V4023) (num-mul V4025 (hd V4024))) (vr-elementwise? (tl V4023) (tl V4024) V4025) false)) (true false))) - -(defun integrate-linear-usub (V4030 V4031) (cond ((and (cons? V4030) (and (cons? (hd V4030)) (and (= sym (hd (hd V4030))) (and (cons? (tl (hd V4030))) (and (= () (tl (tl (hd V4030)))) (and (cons? (tl V4030)) (= () (tl (tl V4030))))))))) (lusub-by-name (str (hd (tl (hd V4030)))) (hd (tl V4030)) V4031)) (true (cons none ())))) - -(defun lusub-by-name (V4038 V4039 V4040) (cond ((= "Sin" V4038) (lusub-emit "Sin" V4039 V4040)) ((= "Cos" V4038) (lusub-emit "Cos" V4039 V4040)) ((= "Exp" V4038) (lusub-emit "Exp" V4039 V4040)) (true (cons none ())))) - -(defun lusub-emit (V4041 V4042 V4043) (lusub-on-coeffs V4041 V4042 (expr->coeffs V4043 V4042))) - -(defun lusub-on-coeffs (V4046 V4047 V4048) (cond ((and (cons? V4048) (and (= some (hd V4048)) (and (cons? (tl V4048)) (and (cons? (hd (tl V4048))) (and (cons? (tl (hd (tl V4048)))) (and (= () (tl (tl (hd (tl V4048))))) (= () (tl (tl V4048))))))))) (cons some (cons (lusub-form V4046 V4047 (hd (tl (hd (tl V4048))))) ()))) (true (cons none ())))) - -(defun lusub-form (V4049 V4050 V4051) (cond ((= "Sin" V4049) (cons (ct-times) (cons (cons int (cons -1 ())) (cons (cons (ct-power) (cons V4051 (cons (cons int (cons -1 ())) ()))) (cons (cons (cons sym (cons Cos ())) (cons V4050 ())) ()))))) ((= "Cos" V4049) (cons (ct-times) (cons (cons (ct-power) (cons V4051 (cons (cons int (cons -1 ())) ()))) (cons (cons (cons sym (cons Sin ())) (cons V4050 ())) ())))) ((= "Exp" V4049) (cons (ct-times) (cons (cons (ct-power) (cons V4051 (cons (cons int (cons -1 ())) ()))) (cons (cons (cons sym (cons Exp ())) (cons V4050 ())) ())))) (true (simple-error "partial function lusub-form")))) - -(defun integrate-pullout (V4056 V4057) (cond ((and (cons? V4056) (and (cons? (hd V4056)) (and (= sym (hd (hd V4056))) (and (cons? (tl (hd V4056))) (= () (tl (tl (hd V4056)))))))) (integrate-pullout-times (str (hd (tl (hd V4056)))) (tl V4056) V4057)) (true (cons none ())))) - -(defun integrate-pullout-times (V4064 V4065 V4066) (cond ((= "Times" V4064) (pullout-build (partition-free V4066 V4065 () ()) V4066)) (true (cons none ())))) - -(defun partition-free (V4067 V4068 V4069 V4070) (cond ((= () V4068) (cons (reverse V4069) (cons (reverse V4070) ()))) ((cons? V4068) (if (free-of? (hd V4068) V4067) (partition-free V4067 (tl V4068) (cons (hd V4068) V4069) V4070) (partition-free V4067 (tl V4068) V4069 (cons (hd V4068) V4070)))) (true (simple-error "partial function partition-free")))) - -(defun pullout-build (V4071 V4072) (cond ((and (cons? V4071) (and (cons? (tl V4071)) (= () (tl (tl V4071))))) (if (or (empty? (hd V4071)) (empty? (hd (tl V4071)))) (cons none ()) (cons some (cons (cons (ct-times) (cons (ibp-times (hd V4071)) (cons (cons (cons sym (cons Integrate ())) (cons (ibp-times (hd (tl V4071))) (cons V4072 ()))) ()))) ())))) (true (simple-error "partial function pullout-build")))) - -(defun true-expr? (V4075) (cond ((and (cons? V4075) (and (= sym (hd V4075)) (and (cons? (tl V4075)) (= () (tl (tl V4075)))))) (= (hd (tl V4075)) True)) (true false))) - -(defun all-true? (V4076) (cond ((= () V4076) true) ((cons? V4076) (if (true-expr? (hd V4076)) (all-true? (tl V4076)) false)) (true (simple-error "partial function all-true?")))) - -(defun ct-plus () (cons sym (cons Plus ()))) - -(defun ct-times () (cons sym (cons Times ()))) - -(defun ct-power () (cons sym (cons Power ()))) - -(defun plus-head? (V4079) (cond ((and (cons? V4079) (and (= sym (hd V4079)) (and (cons? (tl V4079)) (= () (tl (tl V4079)))))) (= (str (hd (tl V4079))) "Plus")) (true false))) - -(defun times-head? (V4082) (cond ((and (cons? V4082) (and (= sym (hd V4082)) (and (cons? (tl V4082)) (= () (tl (tl V4082)))))) (= (str (hd (tl V4082))) "Times")) (true false))) - -(defun power-head? (V4085) (cond ((and (cons? V4085) (and (= sym (hd V4085)) (and (cons? (tl V4085)) (= () (tl (tl V4085)))))) (= (str (hd (tl V4085))) "Power")) (true false))) - -(defun divide-head? (V4088) (cond ((and (cons? V4088) (and (= sym (hd V4088)) (and (cons? (tl V4088)) (= () (tl (tl V4088)))))) (= (str (hd (tl V4088))) "Divide")) (true false))) - -(defun collect-like-terms (V4089) (cond ((and (cons? V4089) (and (= sym (hd V4089)) (and (cons? (tl V4089)) (= () (tl (tl V4089)))))) V4089) ((and (cons? V4089) (and (= int (hd V4089)) (and (cons? (tl V4089)) (= () (tl (tl V4089)))))) V4089) ((and (cons? V4089) (and (= rat (hd V4089)) (and (cons? (tl V4089)) (and (cons? (tl (tl V4089))) (= () (tl (tl (tl V4089)))))))) V4089) ((and (cons? V4089) (and (cons? (tl V4089)) (and (cons? (tl (tl V4089))) (and (= () (tl (tl (tl V4089)))) (divide-head? (hd V4089)))))) (collect-like-terms (cons (ct-times) (cons (hd (tl V4089)) (cons (cons (ct-power) (cons (hd (tl (tl V4089))) (cons (cons int (cons -1 ())) ()))) ()))))) ((and (cons? V4089) (and (cons? (tl V4089)) (and (cons? (hd (tl V4089))) (and (cons? (tl (hd (tl V4089)))) (and (cons? (tl (tl (hd (tl V4089))))) (and (= () (tl (tl (tl (hd (tl V4089)))))) (and (cons? (tl (tl V4089))) (and (= () (tl (tl (tl V4089)))) (nested-power? (hd V4089) (hd (hd (tl V4089))) (hd (tl (tl (hd (tl V4089))))) (hd (tl (tl V4089)))))))))))) (collect-like-terms (cons (ct-power) (cons (hd (tl (hd (tl V4089)))) (cons (num-mul (hd (tl (tl (hd (tl V4089))))) (hd (tl (tl V4089)))) ()))))) ((cons? V4089) (collect-node (hd V4089) (map (lambda Z4090 (collect-like-terms Z4090)) (tl V4089)))) (true V4089))) - -(defun nested-power? (V4091 V4092 V4093 V4094) (if (power-head? V4091) (if (power-head? V4092) (if (rat-expr? V4093) (number-expr? V4094) false) false) false)) - -(defun rat-expr? (V4097) (cond ((and (cons? V4097) (and (= rat (hd V4097)) (and (cons? (tl V4097)) (and (cons? (tl (tl V4097))) (= () (tl (tl (tl V4097)))))))) (and (number? (hd (tl V4097))) (number? (hd (tl (tl V4097)))))) (true false))) - -(defun collect-node (V4098 V4099) (if (plus-head? V4098) (collect-plus V4099) (if (times-head? V4098) (collect-times-node V4099) (cons V4098 V4099)))) - -(defun collect-times-node (V4100) (if (any-plus-factor? V4100) (collect-like-terms (expand-product V4100)) (collect-times V4100))) - -(defun any-plus-factor? (V4101) (cond ((= () V4101) false) ((cons? V4101) (if (plus-head? (head-of (hd V4101))) true (any-plus-factor? (tl V4101)))) (true (simple-error "partial function any-plus-factor?")))) - -(defun head-of (V4106) (cond ((cons? V4106) (hd V4106)) (true (cons none ())))) - -(defun expand-product (V4107) (let W4108 (expand-factors V4107 (cons () ())) (cons (ct-plus) (map (lambda Z4109 (ibp-times Z4109)) W4108)))) - -(defun expand-factors (V4110 V4111) (cond ((= () V4110) (reverse-each V4111)) ((cons? V4110) (expand-factors (tl V4110) (expand-one (hd V4110) V4111))) (true (simple-error "partial function expand-factors")))) - -(defun expand-one (V4112 V4113) (cond ((and (cons? V4112) (plus-head? (hd V4112))) (cartesian-plus (tl V4112) V4113)) (true (map (lambda Z4114 (cons V4112 Z4114)) V4113)))) - -(defun cartesian-plus (V4115 V4116) (cartesian-loop V4115 V4116 ())) - -(defun cartesian-loop (V4119 V4120 V4121) (cond ((= () V4119) V4121) ((cons? V4119) (cartesian-loop (tl V4119) V4120 (append V4121 (map (lambda Z4122 (cons (hd V4119) Z4122)) V4120)))) (true (simple-error "partial function cartesian-loop")))) - -(defun reverse-each (V4123) (cond ((= () V4123) ()) ((cons? V4123) (cons (reverse (hd V4123)) (reverse-each (tl V4123)))) (true (simple-error "partial function reverse-each")))) - -(defun addend-coeff-base (V4124) (cond ((and (cons? V4124) (and (= int (hd V4124)) (and (cons? (tl V4124)) (= () (tl (tl V4124)))))) (cons V4124 (cons (cons int (cons 1 ())) ()))) ((and (cons? V4124) (and (= rat (hd V4124)) (and (cons? (tl V4124)) (and (cons? (tl (tl V4124))) (= () (tl (tl (tl V4124)))))))) (cons V4124 (cons (cons int (cons 1 ())) ()))) ((and (cons? V4124) (times-head? (hd V4124))) (acb-times (tl V4124))) (true (cons (cons int (cons 1 ())) (cons V4124 ()))))) - -(defun acb-times (V4125) (let W4126 (split-num-factors V4125 (cons int (cons 1 ())) ()) (let W4127 (hd W4126) (let W4128 (hd (tl W4126)) (cons W4127 (cons (times-rest-as-expr W4128) ())))))) - -(defun times-rest-as-expr (V4129) (cond ((= () V4129) (cons int (cons 1 ()))) ((and (cons? V4129) (= () (tl V4129))) (hd V4129)) (true (cons (ct-times) V4129)))) - -(defun plus-groups (V4130 V4131) (cond ((= () V4130) V4131) ((cons? V4130) (plus-groups (tl V4130) (plus-add-group (addend-coeff-base (hd V4130)) V4131))) (true (simple-error "partial function plus-groups")))) - -(defun plus-add-group (V4132 V4133) (cond ((and (cons? V4132) (and (cons? (tl V4132)) (and (= () (tl (tl V4132))) (= () V4133)))) (cons V4132 ())) ((and (cons? V4132) (and (cons? (tl V4132)) (and (= () (tl (tl V4132))) (and (cons? V4133) (and (cons? (hd V4133)) (and (cons? (tl (hd V4133))) (= () (tl (tl (hd V4133)))))))))) (if (content-eq (hd (tl V4132)) (hd (tl (hd V4133)))) (cons (cons (num-sum-2 (hd V4132) (hd (hd V4133))) (tl (hd V4133))) (tl V4133)) (cons (hd V4133) (plus-add-group V4132 (tl V4133))))) (true (simple-error "partial function plus-add-group")))) - -(defun num-sum-2 (V4134 V4135) (num-add V4134 V4135)) - -(defun group->addend (V4136) (cond ((and (cons? V4136) (and (cons? (tl V4136)) (and (cons? (hd (tl V4136))) (and (= int (hd (hd (tl V4136)))) (and (cons? (tl (hd (tl V4136)))) (and (= 1 (hd (tl (hd (tl V4136))))) (and (= () (tl (tl (hd (tl V4136))))) (= () (tl (tl V4136)))))))))) (hd V4136)) ((and (cons? V4136) (and (cons? (tl V4136)) (= () (tl (tl V4136))))) (if (num-eq? (hd V4136) (cons int (cons 0 ()))) (cons int (cons 0 ())) (if (num-eq? (hd V4136) (cons int (cons 1 ()))) (hd (tl V4136)) (cons (ct-times) V4136)))) (true (simple-error "partial function group->addend")))) - -(defun zero-expr? (V4137) (if (number-expr? V4137) (num-eq? V4137 (cons int (cons 0 ()))) false)) - -(defun drop-zeros (V4138) (cond ((= () V4138) ()) ((cons? V4138) (if (zero-expr? (hd V4138)) (drop-zeros (tl V4138)) (cons (hd V4138) (drop-zeros (tl V4138))))) (true (simple-error "partial function drop-zeros")))) - -(defun flatten-plus-args (V4139) (cond ((= () V4139) ()) ((cons? V4139) (append (flatten-plus-arg (hd V4139)) (flatten-plus-args (tl V4139)))) (true (simple-error "partial function flatten-plus-args")))) - -(defun flatten-plus-arg (V4140) (cond ((and (cons? V4140) (plus-head? (hd V4140))) (flatten-plus-args (tl V4140))) (true (cons V4140 ())))) - -(defun pyth-fold-addends (V4141) (let W4142 (pyth-find-pair V4141 V4141) (if (= W4142 (cons none ())) V4141 (pyth-apply W4142 V4141)))) - -(defun pyth-trig-term (V4143 V4144) (pyth-trig-cb V4143 (addend-coeff-base V4144))) - -(defun pyth-trig-cb (V4147 V4148) (cond ((and (cons? V4148) (and (cons? (tl V4148)) (and (cons? (hd (tl V4148))) (and (cons? (hd (hd (tl V4148)))) (and (= sym (hd (hd (hd (tl V4148))))) (and (cons? (tl (hd (hd (tl V4148))))) (and (= () (tl (tl (hd (hd (tl V4148)))))) (and (cons? (tl (hd (tl V4148)))) (and (cons? (hd (tl (hd (tl V4148))))) (and (cons? (hd (hd (tl (hd (tl V4148)))))) (and (= sym (hd (hd (hd (tl (hd (tl V4148))))))) (and (cons? (tl (hd (hd (tl (hd (tl V4148))))))) (and (= () (tl (tl (hd (hd (tl (hd (tl V4148)))))))) (and (cons? (tl (hd (tl (hd (tl V4148)))))) (and (= () (tl (tl (hd (tl (hd (tl V4148))))))) (and (cons? (tl (tl (hd (tl V4148))))) (and (= () (tl (tl (tl (hd (tl V4148)))))) (= () (tl (tl V4148)))))))))))))))))))) (pyth-trig-chk V4147 (hd V4148) (hd (tl (hd (tl (hd (tl V4148)))))) (str (hd (tl (hd (hd (tl V4148)))))) (str (hd (tl (hd (hd (tl (hd (tl V4148)))))))) (hd (tl (tl (hd (tl V4148))))))) (true (cons none ())))) - -(defun pyth-trig-chk (V4149 V4150 V4151 V4152 V4153 V4154) (if (= V4152 "Power") (if (= V4153 V4149) (if (number-expr? V4154) (if (num-eq? V4154 (cons int (cons 2 ()))) (cons some (cons (cons V4150 (cons V4151 ())) ())) (cons none ())) (cons none ())) (cons none ())) (cons none ()))) - -(defun pyth-find-pair (V4157 V4158) (cond ((= () V4157) (cons none ())) ((cons? V4157) (pyth-find-pair-step (pyth-trig-term "Sin" (hd V4157)) (tl V4157) V4158)) (true (simple-error "partial function pyth-find-pair")))) - -(defun pyth-find-pair-step (V4159 V4160 V4161) (cond ((and (cons? V4159) (and (= none (hd V4159)) (= () (tl V4159)))) (pyth-find-pair V4160 V4161)) ((and (cons? V4159) (and (= some (hd V4159)) (and (cons? (tl V4159)) (and (cons? (hd (tl V4159))) (and (cons? (tl (hd (tl V4159)))) (and (= () (tl (tl (hd (tl V4159))))) (= () (tl (tl V4159))))))))) (if (pyth-has-cos? (hd (hd (tl V4159))) (hd (tl (hd (tl V4159)))) V4161) V4159 (pyth-find-pair V4160 V4161))) (true (simple-error "partial function pyth-find-pair-step")))) - -(defun pyth-has-cos? (V4162 V4163 V4164) (cond ((= () V4164) false) ((cons? V4164) (pyth-has-cos-step V4162 V4163 (pyth-trig-term "Cos" (hd V4164)) (tl V4164))) (true (simple-error "partial function pyth-has-cos?")))) - -(defun pyth-has-cos-step (V4165 V4166 V4167 V4168) (cond ((and (cons? V4167) (and (= none (hd V4167)) (= () (tl V4167)))) (pyth-has-cos? V4165 V4166 V4168)) ((and (cons? V4167) (and (= some (hd V4167)) (and (cons? (tl V4167)) (and (cons? (hd (tl V4167))) (and (cons? (tl (hd (tl V4167)))) (and (= () (tl (tl (hd (tl V4167))))) (= () (tl (tl V4167))))))))) (if (num-eq? V4165 (hd (hd (tl V4167)))) (if (content-eq V4166 (hd (tl (hd (tl V4167))))) true (pyth-has-cos? V4165 V4166 V4168)) (pyth-has-cos? V4165 V4166 V4168))) (true (simple-error "partial function pyth-has-cos-step")))) - -(defun pyth-apply (V4169 V4170) (cond ((and (cons? V4169) (and (= some (hd V4169)) (and (cons? (tl V4169)) (and (cons? (hd (tl V4169))) (and (cons? (tl (hd (tl V4169)))) (and (= () (tl (tl (hd (tl V4169))))) (= () (tl (tl V4169))))))))) (pyth-fold-addends (drop-zeros (map (lambda Z4171 (group->addend Z4171)) (plus-groups (cons (hd (hd (tl V4169))) (pyth-drop "Cos" (hd (hd (tl V4169))) (hd (tl (hd (tl V4169)))) (pyth-drop "Sin" (hd (hd (tl V4169))) (hd (tl (hd (tl V4169)))) V4170))) ()))))) (true (simple-error "partial function pyth-apply")))) - -(defun pyth-drop (V4172 V4173 V4174 V4175) (cond ((= () V4175) ()) ((cons? V4175) (pyth-drop-step V4172 V4173 V4174 (hd V4175) (tl V4175) (pyth-trig-term V4172 (hd V4175)))) (true (simple-error "partial function pyth-drop")))) - -(defun pyth-drop-step (V4176 V4177 V4178 V4179 V4180 V4181) (cond ((and (cons? V4181) (and (= none (hd V4181)) (= () (tl V4181)))) (cons V4179 (pyth-drop V4176 V4177 V4178 V4180))) ((and (cons? V4181) (and (= some (hd V4181)) (and (cons? (tl V4181)) (and (cons? (hd (tl V4181))) (and (cons? (tl (hd (tl V4181)))) (and (= () (tl (tl (hd (tl V4181))))) (= () (tl (tl V4181))))))))) (if (num-eq? V4177 (hd (hd (tl V4181)))) (if (content-eq V4178 (hd (tl (hd (tl V4181))))) V4180 (cons V4179 (pyth-drop V4176 V4177 V4178 V4180))) (cons V4179 (pyth-drop V4176 V4177 V4178 V4180)))) (true (simple-error "partial function pyth-drop-step")))) - -(defun collect-plus (V4182) (let W4183 (flatten-plus-args V4182) (let W4184 (plus-groups W4183 ()) (let W4185 (drop-zeros (map (lambda Z4186 (group->addend Z4186)) W4184)) (let W4187 (pyth-fold-addends W4185) (rat-zero-or (rebuild-nary (ct-plus) W4187 (cons int (cons 0 ()))) W4187)))))) - -(defun rat-zero-or (V4188 V4189) (if (rat-has-neg-power? V4189) (rat-try-collapse V4188 V4189 (dedup-syms (free-sym-names V4188))) V4188)) - -(defun rat-try-collapse (V4192 V4193 V4194) (cond ((and (cons? V4194) (= () (tl V4194))) (rat-finish V4192 (rat-combine (cons sym V4194) V4193))) (true V4192))) - -(defun rat-finish (V4195 V4196) (cond ((and (cons? V4196) (and (= some (hd V4196)) (and (cons? (tl V4196)) (= () (tl (tl V4196)))))) (if (vec-zero? (hd (tl V4196))) (cons int (cons 0 ())) V4195)) ((and (cons? V4196) (and (= none (hd V4196)) (= () (tl V4196)))) V4195) (true (simple-error "partial function rat-finish")))) - -(defun vec-zero? (V4197) (empty? (trim-coeffs V4197))) - -(defun rat-combine (V4198 V4199) (rat-combine-loop V4198 V4199 (cons (cons int (cons 0 ())) ()) (cons (cons int (cons 1 ())) ()))) - -(defun rat-combine-loop (V4200 V4201 V4202 V4203) (cond ((= () V4201) (cons some (cons V4202 ()))) ((cons? V4201) (rat-combine-step V4200 (tl V4201) V4202 V4203 (rat-addend->frac V4200 (hd V4201)))) (true (simple-error "partial function rat-combine-loop")))) - -(defun rat-combine-step (V4206 V4207 V4208 V4209 V4210) (cond ((and (cons? V4210) (and (= some (hd V4210)) (and (cons? (tl V4210)) (and (cons? (hd (tl V4210))) (and (cons? (tl (hd (tl V4210)))) (and (= () (tl (tl (hd (tl V4210))))) (= () (tl (tl V4210))))))))) (rat-combine-loop V4206 V4207 (vec-add (vec-mul V4208 (hd (tl (hd (tl V4210))))) (vec-mul (hd (hd (tl V4210))) V4209)) (vec-mul V4209 (hd (tl (hd (tl V4210))))))) (true (cons none ())))) - -(defun rat-addend->frac (V4211 V4212) (af-loop V4211 (rat-frac-flatten V4212) (cons (cons int (cons 1 ())) ()) (cons (cons int (cons 1 ())) ()))) - -(defun rat-frac-flatten (V4213) (cond ((and (cons? V4213) (times-head? (hd V4213))) (tl V4213)) (true (cons V4213 ())))) - -(defun af-loop (V4214 V4215 V4216 V4217) (cond ((= () V4215) (cons some (cons (cons V4216 (cons V4217 ())) ()))) ((cons? V4215) (af-step V4214 (tl V4215) V4216 V4217 (af-classify V4214 (hd V4215)))) (true (simple-error "partial function af-loop")))) - -(defun af-step (V4220 V4221 V4222 V4223 V4224) (cond ((and (cons? V4224) (and (= 0 (hd V4224)) (and (cons? (tl V4224)) (= () (tl (tl V4224)))))) (af-loop V4220 V4221 (vec-mul V4222 (hd (tl V4224))) V4223)) ((and (cons? V4224) (and (= 1 (hd V4224)) (and (cons? (tl V4224)) (= () (tl (tl V4224)))))) (af-loop V4220 V4221 V4222 (vec-mul V4223 (hd (tl V4224))))) (true (cons none ())))) - -(defun af-classify (V4225 V4226) (af-class V4225 V4226 (af-den-of V4225 V4226))) - -(defun af-den-of (V4229 V4230) (cond ((and (cons? V4230) (and (cons? (tl V4230)) (and (cons? (tl (tl V4230))) (and (= () (tl (tl (tl V4230)))) (power-head? (hd V4230)))))) (af-den-pow V4229 (hd (tl V4230)) (hd (tl (tl V4230))))) (true (cons none ())))) - -(defun af-den-pow (V4233 V4234 V4235) (cond ((and (cons? V4235) (and (= int (hd V4235)) (and (cons? (tl V4235)) (= () (tl (tl V4235)))))) (if (< (hd (tl V4235)) 0) (af-den-raise V4233 V4234 (- 0 (hd (tl V4235)))) (cons none ()))) (true (cons none ())))) - -(defun af-den-raise (V4236 V4237 V4238) (af-den-raise-2 (expr->coeffs V4236 V4237) V4238)) - -(defun af-den-raise-2 (V4241 V4242) (cond ((and (cons? V4241) (and (= some (hd V4241)) (and (cons? (tl V4241)) (= () (tl (tl V4241)))))) (cons some (cons (vec-pow (hd (tl V4241)) V4242) ()))) (true (cons none ())))) - -(defun af-class (V4245 V4246 V4247) (cond ((and (cons? V4247) (and (= some (hd V4247)) (and (cons? (tl V4247)) (= () (tl (tl V4247)))))) (cons 1 (tl V4247))) (true (af-class-num (expr->coeffs V4245 V4246))))) - -(defun af-class-num (V4250) (cond ((and (cons? V4250) (and (= some (hd V4250)) (and (cons? (tl V4250)) (= () (tl (tl V4250)))))) (cons 0 (tl V4250))) (true (cons none ())))) - -(defun vec-pow (V4251 V4252) (cond ((= 1 V4252) V4251) (true (vec-mul V4251 (vec-pow V4251 (- V4252 1)))))) - -(defun rat-has-neg-power? (V4253) (cond ((= () V4253) false) ((cons? V4253) (if (expr-has-neg-power? (hd V4253)) true (rat-has-neg-power? (tl V4253)))) (true (simple-error "partial function rat-has-neg-power?")))) - -(defun expr-has-neg-power? (V4266) (cond ((and (cons? V4266) (and (= sym (hd V4266)) (and (cons? (tl V4266)) (= () (tl (tl V4266)))))) false) ((and (cons? V4266) (and (= int (hd V4266)) (and (cons? (tl V4266)) (= () (tl (tl V4266)))))) false) ((and (cons? V4266) (and (= rat (hd V4266)) (and (cons? (tl V4266)) (and (cons? (tl (tl V4266))) (= () (tl (tl (tl V4266)))))))) false) ((and (cons? V4266) (and (cons? (tl V4266)) (and (cons? (tl (tl V4266))) (and (= () (tl (tl (tl V4266)))) (power-head? (hd V4266)))))) (rat-np-power (hd V4266) (hd (tl V4266)) (hd (tl (tl V4266))))) ((cons? V4266) (expr-any-neg-power? (tl V4266))) (true false))) - -(defun rat-np-power (V4267 V4268 V4269) (if (neg-num? V4269) true (if (expr-has-neg-power? V4268) true (expr-has-neg-power? V4269)))) - -(defun expr-any-neg-power? (V4270) (cond ((= () V4270) false) ((cons? V4270) (if (expr-has-neg-power? (hd V4270)) true (expr-any-neg-power? (tl V4270)))) (true (simple-error "partial function expr-any-neg-power?")))) - -(defun neg-num? (V4273) (cond ((and (cons? V4273) (and (= int (hd V4273)) (and (cons? (tl V4273)) (and (= () (tl (tl V4273))) (number? (hd (tl V4273))))))) (< (hd (tl V4273)) 0)) ((and (cons? V4273) (and (= rat (hd V4273)) (and (cons? (tl V4273)) (and (cons? (tl (tl V4273))) (and (= () (tl (tl (tl V4273)))) (and (number? (hd (tl V4273))) (number? (hd (tl (tl V4273)))))))))) (< (hd (tl V4273)) 0)) (true false))) - -(defun factor-base-exp (V4274) (cond ((and (cons? V4274) (and (= int (hd V4274)) (and (cons? (tl V4274)) (= () (tl (tl V4274)))))) (cons V4274 (cons (cons int (cons 1 ())) ()))) ((and (cons? V4274) (and (= rat (hd V4274)) (and (cons? (tl V4274)) (and (cons? (tl (tl V4274))) (= () (tl (tl (tl V4274)))))))) (cons V4274 (cons (cons int (cons 1 ())) ()))) ((and (cons? V4274) (and (cons? (tl V4274)) (and (cons? (tl (tl V4274))) (= () (tl (tl (tl V4274))))))) (if (and (power-head? (hd V4274)) (number-expr? (hd (tl (tl V4274))))) (tl V4274) (cons V4274 (cons (cons int (cons 1 ())) ())))) (true (cons V4274 (cons (cons int (cons 1 ())) ()))))) - -(defun times-groups (V4275 V4276) (cond ((= () V4275) V4276) ((cons? V4275) (times-groups (tl V4275) (times-add-group (factor-base-exp (hd V4275)) V4276))) (true (simple-error "partial function times-groups")))) - -(defun times-add-group (V4277 V4278) (cond ((and (cons? V4277) (and (cons? (tl V4277)) (and (= () (tl (tl V4277))) (= () V4278)))) (cons V4277 ())) ((and (cons? V4277) (and (cons? (tl V4277)) (and (= () (tl (tl V4277))) (and (cons? V4278) (and (cons? (hd V4278)) (and (cons? (tl (hd V4278))) (= () (tl (tl (hd V4278)))))))))) (if (content-eq (hd V4277) (hd (hd V4278))) (cons (cons (hd (hd V4278)) (cons (num-add (hd (tl V4277)) (hd (tl (hd V4278)))) ())) (tl V4278)) (cons (hd V4278) (times-add-group V4277 (tl V4278))))) (true (simple-error "partial function times-add-group")))) - -(defun group->factor (V4279) (cond ((and (cons? V4279) (and (cons? (tl V4279)) (= () (tl (tl V4279))))) (if (num-eq? (hd (tl V4279)) (cons int (cons 1 ()))) (hd V4279) (cons (ct-power) V4279))) (true (simple-error "partial function group->factor")))) - -(defun split-num-factors (V4280 V4281 V4282) (cond ((= () V4280) (cons V4281 (cons (reverse V4282) ()))) ((cons? V4280) (if (number-expr? (hd V4280)) (split-num-factors (tl V4280) (num-mul V4281 (hd V4280)) V4282) (split-num-factors (tl V4280) V4281 (cons (hd V4280) V4282)))) (true (simple-error "partial function split-num-factors")))) - -(defun flatten-times-args (V4283) (cond ((= () V4283) ()) ((cons? V4283) (append (flatten-times-arg (hd V4283)) (flatten-times-args (tl V4283)))) (true (simple-error "partial function flatten-times-args")))) - -(defun flatten-times-arg (V4284) (cond ((and (cons? V4284) (times-head? (hd V4284))) (flatten-times-args (tl V4284))) (true (cons V4284 ())))) - -(defun collect-times (V4285) (let W4286 (flatten-times-args V4285) (let W4287 (split-num-factors W4286 (cons int (cons 1 ())) ()) (let W4288 (hd W4287) (let W4289 (hd (tl W4287)) (let W4290 (times-groups W4289 ()) (let W4291 (map (lambda Z4292 (group->factor Z4292)) W4290) (collect-times-rebuild W4288 W4291)))))))) - -(defun collect-times-rebuild (V4293 V4294) (if (num-eq? V4293 (cons int (cons 0 ()))) (cons int (cons 0 ())) (if (num-eq? V4293 (cons int (cons 1 ()))) (rebuild-nary (ct-times) V4294 (cons int (cons 1 ()))) (rebuild-nary (ct-times) (cons V4293 V4294) (cons int (cons 1 ())))))) - -(defun rebuild-nary (V4299 V4300 V4301) (cond ((= () V4300) V4301) ((and (cons? V4300) (= () (tl V4300))) (hd V4300)) (true (cons V4299 V4300)))) - -(defun ibp-max-depth () 3) - -(defun ibp-antideriv (V4308 V4309 V4310) (cond ((and (cons? V4308) (and (= sym (hd V4308)) (and (cons? (tl V4308)) (and (= () (tl (tl V4308))) (and (cons? V4310) (= () (tl V4310))))))) (ibp-antideriv-by-name (str (hd (tl V4308))) V4309 (hd V4310))) (true (cons none ())))) - -(defun ibp-antideriv-by-name (V4317 V4318 V4319) (cond ((= "Sin" V4317) (if (content-eq V4319 V4318) (cons some (cons (cons (ct-times) (cons (cons int (cons -1 ())) (cons (cons (cons sym (cons Cos ())) (cons V4319 ())) ()))) ())) (cons none ()))) ((= "Cos" V4317) (if (content-eq V4319 V4318) (cons some (cons (cons (cons sym (cons Sin ())) (cons V4319 ())) ())) (cons none ()))) ((= "Exp" V4317) (if (content-eq V4319 V4318) (cons some (cons (cons (cons sym (cons Exp ())) (cons V4319 ())) ())) (cons none ()))) (true (cons none ())))) - -(defun ibp-split-product (V4320 V4321) (ibp-split-loop V4320 V4321 ())) - -(defun ibp-split-loop (V4324 V4325 V4326) (cond ((= () V4325) (cons none ())) ((cons? V4325) (if (ibp-g-factor? V4324 (hd V4325)) (cons some (cons (cons (hd V4325) (cons (append (reverse V4326) (tl V4325)) ())) ())) (ibp-split-loop V4324 (tl V4325) (cons (hd V4325) V4326)))) (true (simple-error "partial function ibp-split-loop")))) - -(defun ibp-g-factor? (V4331 V4332) (cond ((and (cons? V4332) (and (cons? (hd V4332)) (and (= sym (hd (hd V4332))) (and (cons? (tl (hd V4332))) (and (= () (tl (tl (hd V4332)))) (and (cons? (tl V4332)) (= () (tl (tl V4332))))))))) (and (ibp-table-name? (str (hd (tl (hd V4332))))) (content-eq (hd (tl V4332)) V4331))) (true false))) - -(defun ibp-table-name? (V4335) (cond ((= "Sin" V4335) true) ((= "Cos" V4335) true) ((= "Exp" V4335) true) (true false))) - -(defun poly-in-var? (V4345 V4346) (cond ((= V4345 V4346) true) ((and (cons? V4346) (and (= int (hd V4346)) (and (cons? (tl V4346)) (= () (tl (tl V4346)))))) true) ((and (cons? V4346) (and (= rat (hd V4346)) (and (cons? (tl V4346)) (and (cons? (tl (tl V4346))) (= () (tl (tl (tl V4346)))))))) true) ((and (cons? V4346) (and (cons? (hd V4346)) (and (= sym (hd (hd V4346))) (and (cons? (tl (hd V4346))) (and (= () (tl (tl (hd V4346)))) (and (cons? (tl V4346)) (and (cons? (tl (tl V4346))) (and (= () (tl (tl (tl V4346)))) (= (str (hd (tl (hd V4346)))) "Power"))))))))) (and (power-head? (hd V4346)) (and (content-eq (hd (tl V4346)) V4345) (number-expr? (hd (tl (tl V4346))))))) ((and (cons? V4346) (and (cons? (hd V4346)) (and (= sym (hd (hd V4346))) (and (cons? (tl (hd V4346))) (and (= () (tl (tl (hd V4346)))) (or (= (str (hd (tl (hd V4346)))) "Times") (= (str (hd (tl (hd V4346)))) "Plus"))))))) (poly-args? V4345 (tl V4346))) (true false))) - -(defun poly-args? (V4347 V4348) (cond ((= () V4348) true) ((cons? V4348) (if (poly-in-var? V4347 (hd V4348)) (poly-args? V4347 (tl V4348)) false)) (true (simple-error "partial function poly-args?")))) - -(defun ibp-times (V4349) (cond ((= () V4349) (cons int (cons 1 ()))) ((and (cons? V4349) (= () (tl V4349))) (hd V4349)) (true (cons (ct-times) V4349)))) - -(defun ibp-integrate (V4350 V4351) (cons (cons sym (cons Integrate ())) (cons V4350 (cons V4351 ())))) - -(defun has-integrate-head? (V4360) (cond ((and (cons? V4360) (and (= sym (hd V4360)) (and (cons? (tl V4360)) (= () (tl (tl V4360)))))) false) ((and (cons? V4360) (and (= int (hd V4360)) (and (cons? (tl V4360)) (= () (tl (tl V4360)))))) false) ((and (cons? V4360) (and (= rat (hd V4360)) (and (cons? (tl V4360)) (and (cons? (tl (tl V4360))) (= () (tl (tl (tl V4360)))))))) false) ((and (cons? V4360) (and (cons? (hd V4360)) (and (= sym (hd (hd V4360))) (and (cons? (tl (hd V4360))) (= () (tl (tl (hd V4360)))))))) (if (= (str (hd (tl (hd V4360)))) "Integrate") true (has-integrate-list? (tl V4360)))) ((cons? V4360) (if (has-integrate-head? (hd V4360)) true (has-integrate-list? (tl V4360)))) (true false))) - -(defun has-integrate-list? (V4361) (cond ((= () V4361) false) ((cons? V4361) (if (has-integrate-head? (hd V4361)) true (has-integrate-list? (tl V4361)))) (true (simple-error "partial function has-integrate-list?")))) - -(defun integrate-by-parts (V4362 V4363) (ibp-attempt V4362 V4363 (ibp-max-depth))) - -(defun ibp-attempt (V4364 V4365 V4366) (cond ((= 0 V4366) (cons none ())) (true (ibp-on-form V4364 V4365 V4366)))) - -(defun ibp-on-form (V4373 V4374 V4375) (cond ((and (cons? V4373) (and (cons? (hd V4373)) (and (= sym (hd (hd V4373))) (and (cons? (tl (hd V4373))) (= () (tl (tl (hd V4373)))))))) (ibp-with-split (str (hd (tl (hd V4373)))) (tl V4373) V4374 V4375)) (true (cons none ())))) - -(defun ibp-with-split (V4384 V4385 V4386 V4387) (cond ((= "Times" V4384) (ibp-dispatch-split (ibp-split-product V4386 V4385) V4386 V4387)) (true (cons none ())))) - -(defun ibp-dispatch-split (V4392 V4393 V4394) (cond ((and (cons? V4392) (and (= none (hd V4392)) (= () (tl V4392)))) V4392) ((and (cons? V4392) (and (= some (hd V4392)) (and (cons? (tl V4392)) (and (cons? (hd (tl V4392))) (and (cons? (tl (hd (tl V4392)))) (and (= () (tl (tl (hd (tl V4392))))) (= () (tl (tl V4392))))))))) (let W4395 (ibp-times (hd (tl (hd (tl V4392))))) (if (poly-in-var? V4393 W4395) (ibp-go W4395 (hd (hd (tl V4392))) V4393 V4394) (cons none ())))) (true (simple-error "partial function ibp-dispatch-split")))) - -(defun ibp-go (V4404 V4405 V4406 V4407) (cond ((and (cons? V4405) (and (cons? (tl V4405)) (= () (tl (tl V4405))))) (ibp-build V4404 (ibp-antideriv (hd V4405) V4406 (tl V4405)) V4406 V4407)) (true (cons none ())))) - -(defun ibp-build (V4408 V4409 V4410 V4411) (cond ((and (cons? V4409) (and (= none (hd V4409)) (= () (tl V4409)))) V4409) ((and (cons? V4409) (and (= some (hd V4409)) (and (cons? (tl V4409)) (= () (tl (tl V4409)))))) (let W4412 (cons (cons sym (cons D ())) (cons V4408 (cons V4410 ()))) (let W4413 (cons (ct-times) (cons (hd (tl V4409)) (cons W4412 ()))) (let W4414 (normal-form (ibp-integrate W4413 V4410)) (if (has-integrate-head? W4414) (cons none ()) (cons some (cons (collect-like-terms (normal-form (cons (ct-plus) (cons (cons (ct-times) (cons V4408 (tl V4409))) (cons (cons (ct-times) (cons (cons int (cons -1 ())) (cons W4414 ()))) ()))))) ()))))))) (true (simple-error "partial function ibp-build")))) - -(defun integ-diffback-ok? (V4415 V4416 V4417) (content-eq (reduce (cons (cons sym (cons Simplify ())) (cons (cons (ct-plus) (cons (cons (cons sym (cons D ())) (cons V4415 (cons V4417 ()))) (cons (cons (ct-times) (cons (cons int (cons -1 ())) (cons V4416 ()))) ()))) ()))) (cons int (cons 0 ())))) - -(defun integrate-invfun (V4422 V4423) (cond ((and (cons? V4422) (and (cons? (hd V4422)) (and (= sym (hd (hd V4422))) (and (cons? (tl (hd V4422))) (and (= () (tl (tl (hd V4422)))) (and (cons? (tl V4422)) (= () (tl (tl V4422))))))))) (iv-by-name (str (hd (tl (hd V4422)))) (hd (tl V4422)) V4423)) (true (cons none ())))) - -(defun iv-by-name (V4430 V4431 V4432) (cond ((and (= "ArcTan" V4430) (content-eq V4431 V4432)) (iv-commit (iv-candidate "ArcTan" V4432) (cons (cons sym (cons ArcTan ())) (cons V4431 ())) V4432)) ((and (= "ArcSin" V4430) (content-eq V4431 V4432)) (iv-commit (iv-candidate "ArcSin" V4432) (cons (cons sym (cons ArcSin ())) (cons V4431 ())) V4432)) (true (cons none ())))) - -(defun iv-candidate (V4433 V4434) (cond ((= "ArcTan" V4433) (cons (ct-plus) (cons (cons (ct-times) (cons V4434 (cons (cons (cons sym (cons ArcTan ())) (cons V4434 ())) ()))) (cons (cons (ct-times) (cons (cons rat (cons -1 (cons 2 ()))) (cons (cons (cons sym (cons Log ())) (cons (cons (ct-plus) (cons (cons int (cons 1 ())) (cons (cons (ct-power) (cons V4434 (cons (cons int (cons 2 ())) ()))) ()))) ())) ()))) ())))) ((= "ArcSin" V4433) (cons (ct-plus) (cons (cons (ct-times) (cons V4434 (cons (cons (cons sym (cons ArcSin ())) (cons V4434 ())) ()))) (cons (cons (ct-power) (cons (cons (ct-plus) (cons (cons int (cons 1 ())) (cons (cons (ct-times) (cons (cons int (cons -1 ())) (cons (cons (ct-power) (cons V4434 (cons (cons int (cons 2 ())) ()))) ()))) ()))) (cons (cons rat (cons 1 (cons 2 ()))) ()))) ())))) (true (simple-error "partial function iv-candidate")))) - -(defun iv-commit (V4435 V4436 V4437) (if (integ-diffback-ok? V4435 V4436 V4437) (cons some (cons V4435 ())) (cons none ()))) - -(defun integrate-log-parts (V4438 V4439) (if (ilog-log-of-var? V4439 V4438) (ilog-emit V4439 (cons int (cons 0 ()))) (ilog-on-form V4438 V4439))) - -(defun ilog-log-of-var? (V4442 V4443) (cond ((and (cons? V4443) (and (cons? (hd V4443)) (and (= sym (hd (hd V4443))) (and (cons? (tl (hd V4443))) (and (= () (tl (tl (hd V4443)))) (and (cons? (tl V4443)) (= () (tl (tl V4443))))))))) (if (= (str (hd (tl (hd V4443)))) "Log") (content-eq (hd (tl V4443)) V4442) false)) (true false))) - -(defun ilog-on-form (V4448 V4449) (cond ((and (cons? V4448) (and (cons? (hd V4448)) (and (= sym (hd (hd V4448))) (and (cons? (tl (hd V4448))) (= () (tl (tl (hd V4448)))))))) (ilog-on-times (str (hd (tl (hd V4448)))) (tl V4448) V4449)) (true (cons none ())))) - -(defun ilog-on-times (V4456 V4457 V4458) (cond ((= "Times" V4456) (ilog-find-log V4457 V4458 ())) (true (cons none ())))) - -(defun ilog-find-log (V4463 V4464 V4465) (cond ((= () V4463) (cons none ())) ((cons? V4463) (if (ilog-log-of-var? V4464 (hd V4463)) (ilog-rest-exp (append (reverse V4465) (tl V4463)) V4464) (ilog-find-log (tl V4463) V4464 (cons (hd V4463) V4465)))) (true (simple-error "partial function ilog-find-log")))) - -(defun ilog-rest-exp (V4470 V4471) (cond ((and (cons? V4470) (= () (tl V4470))) (ilog-rest-exp-1 (hd V4470) V4471)) (true (cons none ())))) - -(defun ilog-rest-exp-1 (V4472 V4473) (cond ((and (cons? V4472) (and (cons? (hd V4472)) (and (= sym (hd (hd V4472))) (and (cons? (tl (hd V4472))) (and (= () (tl (tl (hd V4472)))) (and (cons? (tl V4472)) (and (cons? (tl (tl V4472))) (= () (tl (tl (tl V4472))))))))))) (ilog-rest-power (str (hd (tl (hd V4472)))) (hd (tl V4472)) (hd (tl (tl V4472))) V4473)) (true (if (content-eq V4472 V4473) (ilog-emit V4473 (cons int (cons 1 ()))) (cons none ()))))) - -(defun ilog-rest-power (V4482 V4483 V4484 V4485) (cond ((= "Power" V4482) (if (content-eq V4483 V4485) (if (number-expr? V4484) (ilog-emit V4485 V4484) (cons none ())) (cons none ()))) (true (cons none ())))) - -(defun ilog-integrand (V4486 V4487) (cond ((and (cons? V4487) (and (= int (hd V4487)) (and (cons? (tl V4487)) (and (= 0 (hd (tl V4487))) (= () (tl (tl V4487))))))) (cons (cons sym (cons Log ())) (cons V4486 ()))) (true (cons (ct-times) (cons (cons (ct-power) (cons V4486 (cons V4487 ()))) (cons (cons (cons sym (cons Log ())) (cons V4486 ())) ())))))) - -(defun ilog-emit (V4488 V4489) (ilog-build V4488 V4489 (num-add V4489 (cons int (cons 1 ()))))) - -(defun ilog-build (V4490 V4491 V4492) (if (num-eq? V4492 (cons int (cons 0 ()))) (cons none ()) (let W4493 (cons (ct-plus) (cons (cons (ct-times) (cons (num-div (cons int (cons 1 ())) V4492) (cons (cons (ct-power) (cons V4490 (cons V4492 ()))) (cons (cons (cons sym (cons Log ())) (cons V4490 ())) ())))) (cons (cons (ct-times) (cons (cons int (cons -1 ())) (cons (num-div (cons int (cons 1 ())) (num-mul V4492 V4492)) (cons (cons (ct-power) (cons V4490 (cons V4492 ()))) ())))) ()))) (if (integ-diffback-ok? W4493 (ilog-integrand V4490 V4491) V4490) (cons some (cons W4493 ())) (cons none ()))))) - -(defun integrate-cyclic (V4498 V4499) (cond ((and (cons? V4498) (and (cons? (hd V4498)) (and (= sym (hd (hd V4498))) (and (cons? (tl (hd V4498))) (and (= () (tl (tl (hd V4498)))) (and (cons? (tl V4498)) (and (cons? (tl (tl V4498))) (= () (tl (tl (tl V4498))))))))))) (icyc-times (str (hd (tl (hd V4498)))) (hd (tl V4498)) (hd (tl (tl V4498))) V4499)) (true (cons none ())))) - -(defun icyc-times (V4508 V4509 V4510 V4511) (cond ((= "Times" V4508) (icyc-pair V4509 V4510 V4511)) (true (cons none ())))) - -(defun icyc-pair (V4512 V4513 V4514) (if (icyc-exp? V4512 V4514) (icyc-emit (icyc-trig-name V4513 V4514) V4514 V4513) (if (icyc-exp? V4513 V4514) (icyc-emit (icyc-trig-name V4512 V4514) V4514 V4512) (cons none ())))) - -(defun icyc-exp? (V4519 V4520) (cond ((and (cons? V4519) (and (cons? (hd V4519)) (and (= sym (hd (hd V4519))) (and (cons? (tl (hd V4519))) (and (= () (tl (tl (hd V4519)))) (and (cons? (tl V4519)) (= () (tl (tl V4519))))))))) (if (= (str (hd (tl (hd V4519)))) "Exp") (content-eq (hd (tl V4519)) V4520) false)) (true false))) - -(defun icyc-trig-name (V4525 V4526) (cond ((and (cons? V4525) (and (cons? (hd V4525)) (and (= sym (hd (hd V4525))) (and (cons? (tl (hd V4525))) (and (= () (tl (tl (hd V4525)))) (and (cons? (tl V4525)) (= () (tl (tl V4525))))))))) (icyc-trig-name-2 (str (hd (tl (hd V4525)))) (hd (tl V4525)) V4526)) (true ""))) - -(defun icyc-trig-name-2 (V4533 V4534 V4535) (cond ((= "Sin" V4533) (if (content-eq V4534 V4535) "Sin" "")) ((= "Cos" V4533) (if (content-eq V4534 V4535) "Cos" "")) (true ""))) - -(defun icyc-emit (V4542 V4543 V4544) (cond ((= "Sin" V4542) (icyc-gate (cons (ct-times) (cons (cons rat (cons 1 (cons 2 ()))) (cons (cons (cons sym (cons Exp ())) (cons V4543 ())) (cons (cons (ct-plus) (cons (cons (cons sym (cons Sin ())) (cons V4543 ())) (cons (cons (ct-times) (cons (cons int (cons -1 ())) (cons (cons (cons sym (cons Cos ())) (cons V4543 ())) ()))) ()))) ())))) (cons (ct-times) (cons (cons (cons sym (cons Exp ())) (cons V4543 ())) (cons V4544 ()))) V4543)) ((= "Cos" V4542) (icyc-gate (cons (ct-times) (cons (cons rat (cons 1 (cons 2 ()))) (cons (cons (cons sym (cons Exp ())) (cons V4543 ())) (cons (cons (ct-plus) (cons (cons (cons sym (cons Sin ())) (cons V4543 ())) (cons (cons (cons sym (cons Cos ())) (cons V4543 ())) ()))) ())))) (cons (ct-times) (cons (cons (cons sym (cons Exp ())) (cons V4543 ())) (cons V4544 ()))) V4543)) (true (cons none ())))) - -(defun icyc-gate (V4545 V4546 V4547) (if (integ-diffback-ok? V4545 V4546 V4547) (cons some (cons V4545 ())) (cons none ()))) - -(defun integrate-trigpow (V4552 V4553) (cond ((and (cons? V4552) (and (cons? (hd V4552)) (and (= sym (hd (hd V4552))) (and (cons? (tl (hd V4552))) (and (= () (tl (tl (hd V4552)))) (and (cons? (tl V4552)) (and (cons? (hd (tl V4552))) (and (cons? (hd (hd (tl V4552)))) (and (= sym (hd (hd (hd (tl V4552))))) (and (cons? (tl (hd (hd (tl V4552))))) (and (= () (tl (tl (hd (hd (tl V4552)))))) (and (cons? (tl (hd (tl V4552)))) (and (= () (tl (tl (hd (tl V4552))))) (and (cons? (tl (tl V4552))) (= () (tl (tl (tl V4552)))))))))))))))))) (itp-power (str (hd (tl (hd V4552)))) (str (hd (tl (hd (hd (tl V4552)))))) (hd (tl (hd (tl V4552)))) (hd (tl (tl V4552))) V4553)) (true (cons none ())))) - -(defun itp-power (V4564 V4565 V4566 V4567 V4568) (cond ((= "Power" V4564) (if (content-eq V4566 V4568) (if (number-expr? V4567) (if (num-eq? V4567 (cons int (cons 2 ()))) (itp-emit V4565 V4568) (cons none ())) (cons none ())) (cons none ()))) (true (cons none ())))) - -(defun itp-emit (V4573 V4574) (cond ((= "Cos" V4573) (itp-gate (itp-half-plus V4574 (cons int (cons 1 ()))) (cons (ct-power) (cons (cons (cons sym (cons Cos ())) (cons V4574 ())) (cons (cons int (cons 2 ())) ()))) V4574)) ((= "Sin" V4573) (itp-gate (itp-half-plus V4574 (cons int (cons -1 ()))) (cons (ct-power) (cons (cons (cons sym (cons Sin ())) (cons V4574 ())) (cons (cons int (cons 2 ())) ()))) V4574)) ((= "Sec" V4573) (itp-gate (cons (cons sym (cons Tan ())) (cons V4574 ())) (cons (ct-power) (cons (cons (cons sym (cons Sec ())) (cons V4574 ())) (cons (cons int (cons 2 ())) ()))) V4574)) (true (cons none ())))) - -(defun itp-half-plus (V4575 V4576) (cons (ct-plus) (cons (cons (ct-times) (cons (cons rat (cons 1 (cons 2 ()))) (cons V4575 ()))) (cons (cons (ct-times) (cons (cons rat (cons 1 (cons 2 ()))) (cons V4576 (cons (cons (cons sym (cons Sin ())) (cons V4575 ())) (cons (cons (cons sym (cons Cos ())) (cons V4575 ())) ()))))) ())))) - -(defun itp-gate (V4577 V4578 V4579) (if (integ-diffback-ok? V4577 V4578 V4579) (cons some (cons V4577 ())) (cons none ()))) - -(defun ct-divide () (cons sym (cons Divide ()))) - -(defun integrate-sincos (V4584 V4585) (cond ((and (cons? V4584) (and (cons? (hd V4584)) (and (= sym (hd (hd V4584))) (and (cons? (tl (hd V4584))) (and (= () (tl (tl (hd V4584)))) (and (cons? (tl V4584)) (and (cons? (tl (tl V4584))) (= () (tl (tl (tl V4584))))))))))) (isc-times (str (hd (tl (hd V4584)))) (hd (tl V4584)) (hd (tl (tl V4584))) V4585)) (true (cons none ())))) - -(defun isc-times (V4594 V4595 V4596 V4597) (cond ((= "Times" V4594) (isc-pair V4595 V4596 V4597)) (true (cons none ())))) - -(defun isc-pair (V4598 V4599 V4600) (if (isc-is? "Sin" V4598 V4600) (if (isc-is? "Cos" V4599 V4600) (isc-emit V4600) (cons none ())) (if (isc-is? "Cos" V4598 V4600) (if (isc-is? "Sin" V4599 V4600) (isc-emit V4600) (cons none ())) (cons none ())))) - -(defun isc-is? (V4605 V4606 V4607) (cond ((and (cons? V4606) (and (cons? (hd V4606)) (and (= sym (hd (hd V4606))) (and (cons? (tl (hd V4606))) (and (= () (tl (tl (hd V4606)))) (and (cons? (tl V4606)) (= () (tl (tl V4606))))))))) (if (= (str (hd (tl (hd V4606)))) V4605) (content-eq (hd (tl V4606)) V4607) false)) (true false))) - -(defun isc-emit (V4608) (let W4609 (cons (ct-times) (cons (cons rat (cons 1 (cons 2 ()))) (cons (cons (ct-power) (cons (cons (cons sym (cons Sin ())) (cons V4608 ())) (cons (cons int (cons 2 ())) ()))) ()))) (let W4610 (cons (ct-times) (cons (cons (cons sym (cons Sin ())) (cons V4608 ())) (cons (cons (cons sym (cons Cos ())) (cons V4608 ())) ()))) (if (integ-diffback-ok? W4609 W4610 V4608) (cons some (cons W4609 ())) (cons none ()))))) - -(defun integrate-powusub (V4615 V4616) (cond ((and (cons? V4615) (and (cons? (hd V4615)) (and (= sym (hd (hd V4615))) (and (cons? (tl (hd V4615))) (and (= () (tl (tl (hd V4615)))) (and (cons? (tl V4615)) (and (cons? (tl (tl V4615))) (= () (tl (tl (tl V4615))))))))))) (ipow-by-head (str (hd (tl (hd V4615)))) (hd (tl V4615)) (hd (tl (tl V4615))) V4615 V4616)) (true (cons none ())))) - -(defun ipow-by-head (V4627 V4628 V4629 V4630 V4631) (cond ((= "Power" V4627) (if (number-expr? V4629) (ipow-on (expr->coeffs V4631 V4628) V4629 V4628 V4630 V4631) (cons none ()))) ((= "Divide" V4627) (ipow-div V4628 V4629 V4630 V4631)) (true (cons none ())))) - -(defun ipow-div (V4640 V4641 V4642 V4643) (cond ((and (cons? V4640) (and (= int (hd V4640)) (and (cons? (tl V4640)) (and (= 1 (hd (tl V4640))) (and (= () (tl (tl V4640))) (and (cons? V4641) (and (cons? (hd V4641)) (and (= sym (hd (hd V4641))) (and (cons? (tl (hd V4641))) (and (= () (tl (tl (hd V4641)))) (and (cons? (tl V4641)) (and (cons? (tl (tl V4641))) (= () (tl (tl (tl V4641)))))))))))))))) (ipow-div-2 (str (hd (tl (hd V4641)))) (hd (tl V4641)) (hd (tl (tl V4641))) V4642 V4643)) (true (cons none ())))) - -(defun ipow-div-2 (V4654 V4655 V4656 V4657 V4658) (cond ((= "Power" V4654) (if (number-expr? V4656) (ipow-on (expr->coeffs V4658 V4655) (num-mul (cons int (cons -1 ())) V4656) V4655 V4657 V4658) (cons none ()))) (true (cons none ())))) - -(defun ipow-on (V4669 V4670 V4671 V4672 V4673) (cond ((and (cons? V4669) (and (= some (hd V4669)) (and (cons? (tl V4669)) (and (cons? (hd (tl V4669))) (and (cons? (tl (hd (tl V4669)))) (and (= () (tl (tl (hd (tl V4669))))) (= () (tl (tl V4669))))))))) (ipow-emit (hd (tl (hd (tl V4669)))) V4670 V4671 V4672 V4673)) (true (cons none ())))) - -(defun ipow-emit (V4674 V4675 V4676 V4677 V4678) (ipow-np1 V4674 (num-add V4675 (cons int (cons 1 ()))) V4676 V4677 V4678)) - -(defun ipow-np1 (V4679 V4680 V4681 V4682 V4683) (if (num-eq? V4680 (cons int (cons 0 ()))) (cons none ()) (ipow-gate (cons (ct-times) (cons (num-div (cons int (cons 1 ())) (num-mul V4679 V4680)) (cons (cons (ct-power) (cons V4681 (cons V4680 ()))) ()))) V4682 V4683))) - -(defun ipow-gate (V4684 V4685 V4686) (if (integ-diffback-ok? V4684 V4685 V4686) (cons some (cons V4684 ())) (cons none ()))) - -(defun integrate-arcsin (V4691 V4692) (cond ((and (cons? V4691) (and (cons? (hd V4691)) (and (= sym (hd (hd V4691))) (and (cons? (tl (hd V4691))) (and (= () (tl (tl (hd V4691)))) (and (cons? (tl V4691)) (and (cons? (tl (tl V4691))) (= () (tl (tl (tl V4691))))))))))) (iasin-div (str (hd (tl (hd V4691)))) (hd (tl V4691)) (hd (tl (tl V4691))) V4692)) (true (cons none ())))) - -(defun iasin-div (V4701 V4702 V4703 V4704) (cond ((and (= "Divide" V4701) (and (cons? V4702) (and (= int (hd V4702)) (and (cons? (tl V4702)) (and (= 1 (hd (tl V4702))) (= () (tl (tl V4702)))))))) (iasin-den V4703 V4704)) (true (cons none ())))) - -(defun iasin-den (V4709 V4710) (cond ((and (cons? V4709) (and (cons? (hd V4709)) (and (= sym (hd (hd V4709))) (and (cons? (tl (hd V4709))) (and (= () (tl (tl (hd V4709)))) (and (cons? (tl V4709)) (and (cons? (tl (tl V4709))) (= () (tl (tl (tl V4709))))))))))) (iasin-sqrt (str (hd (tl (hd V4709)))) (hd (tl V4709)) (hd (tl (tl V4709))) V4710)) (true (cons none ())))) - -(defun iasin-sqrt (V4719 V4720 V4721 V4722) (cond ((and (= "Power" V4719) (and (cons? V4721) (and (= rat (hd V4721)) (and (cons? (tl V4721)) (and (= 1 (hd (tl V4721))) (and (cons? (tl (tl V4721))) (and (= 2 (hd (tl (tl V4721)))) (= () (tl (tl (tl V4721))))))))))) (iasin-on (expr->coeffs V4722 V4720) V4720 V4722)) (true (cons none ())))) - -(defun iasin-on (V4729 V4730 V4731) (cond ((and (cons? V4729) (and (= some (hd V4729)) (and (cons? (tl V4729)) (and (cons? (hd (tl V4729))) (and (cons? (tl (hd (tl V4729)))) (and (cons? (tl (tl (hd (tl V4729))))) (and (= () (tl (tl (tl (hd (tl V4729)))))) (= () (tl (tl V4729)))))))))) (if (one-minus-xsq? (hd (hd (tl V4729))) (hd (tl (hd (tl V4729)))) (hd (tl (tl (hd (tl V4729)))))) (iasin-gate V4730 V4731) (cons none ()))) (true (cons none ())))) - -(defun one-minus-xsq? (V4732 V4733 V4734) (if (content-eq V4732 (cons int (cons 1 ()))) (if (content-eq V4733 (cons int (cons 0 ()))) (content-eq V4734 (cons int (cons -1 ()))) false) false)) - -(defun iasin-gate (V4735 V4736) (let W4737 (cons (cons sym (cons ArcSin ())) (cons V4736 ())) (let W4738 (cons (ct-divide) (cons (cons int (cons 1 ())) (cons (cons (ct-power) (cons V4735 (cons (cons rat (cons 1 (cons 2 ()))) ()))) ()))) (if (integ-diffback-ok? W4737 W4738 V4736) (cons some (cons W4737 ())) (cons none ()))))) - -(pr "calc-helpers.shen loaded (SameQ/UnsameQ/FreeQ/NumberQ/Positive/And/Simplify + free-of? + collect-like-terms + integrate-by-parts). -" (stoutput)) - -(defun poly-plus-head? (V4741) (cond ((and (cons? V4741) (and (= sym (hd V4741)) (and (cons? (tl V4741)) (= () (tl (tl V4741)))))) (= (str (hd (tl V4741))) "Plus")) (true false))) - -(defun poly-times-head? (V4744) (cond ((and (cons? V4744) (and (= sym (hd V4744)) (and (cons? (tl V4744)) (= () (tl (tl V4744)))))) (= (str (hd (tl V4744))) "Times")) (true false))) - -(defun poly-power-head? (V4747) (cond ((and (cons? V4747) (and (= sym (hd V4747)) (and (cons? (tl V4747)) (= () (tl (tl V4747)))))) (= (str (hd (tl V4747))) "Power")) (true false))) - -(defun poly-ct-plus () (cons sym (cons Plus ()))) - -(defun poly-ct-times () (cons sym (cons Times ()))) - -(defun poly-ct-power () (cons sym (cons Power ()))) - -(defun nonneg-int-exp? (V4750) (cond ((and (cons? V4750) (and (= int (hd V4750)) (and (cons? (tl V4750)) (= () (tl (tl V4750)))))) (>= (hd (tl V4750)) 0)) (true false))) - -(defun expr->poly (V4751) (if (numeric? V4751) (const-poly V4751) (poly-of-compound V4751))) - -(defun poly-of-compound (V4752) (cond ((cons? V4752) (poly-of-head (hd V4752) (tl V4752))) (true (gen-poly V4752)))) - -(defun poly-of-head (V4753 V4754) (if (poly-plus-head? V4753) (poly-sum-list V4754) (if (poly-times-head? V4753) (poly-prod-list V4754) (if (poly-power-head? V4753) (poly-of-power V4754 (cons V4753 V4754)) (gen-poly (cons V4753 V4754)))))) - -(defun poly-of-power (V4757 V4758) (cond ((and (cons? V4757) (and (cons? (tl V4757)) (= () (tl (tl V4757))))) (if (nonneg-int-exp? (hd (tl V4757))) (poly-pow (expr->poly (hd V4757)) (hd (tl (hd (tl V4757))))) (gen-poly V4758))) (true (gen-poly V4758)))) - -(defun poly-sum-list (V4759) (cond ((= () V4759) (zero-poly)) ((cons? V4759) (poly-add (expr->poly (hd V4759)) (poly-sum-list (tl V4759)))) (true (simple-error "partial function poly-sum-list")))) - -(defun poly-prod-list (V4760) (cond ((= () V4760) (one-poly)) ((cons? V4760) (poly-mul (expr->poly (hd V4760)) (poly-prod-list (tl V4760)))) (true (simple-error "partial function poly-prod-list")))) - -(defun zero-poly () ()) - -(defun one-poly () (cons (cons (cons int (cons 1 ())) (cons () ())) ())) - -(defun const-poly (V4761) (if (num-eq? V4761 (cons int (cons 0 ()))) () (cons (cons V4761 (cons () ())) ()))) - -(defun gen-poly (V4762) (cons (cons (cons int (cons 1 ())) (cons (cons (cons V4762 (cons (cons int (cons 1 ())) ())) ()) ())) ())) - -(defun term-coeff (V4765) (cond ((and (cons? V4765) (and (cons? (tl V4765)) (= () (tl (tl V4765))))) (hd V4765)) (true (simple-error "partial function term-coeff")))) - -(defun term-mono (V4768) (cond ((and (cons? V4768) (and (cons? (tl V4768)) (= () (tl (tl V4768))))) (hd (tl V4768))) (true (simple-error "partial function term-mono")))) - -(defun mono-mul (V4769 V4770) (cond ((= () V4769) V4770) ((= () V4770) V4769) ((and (cons? V4769) (and (cons? (hd V4769)) (and (cons? (tl (hd V4769))) (and (= () (tl (tl (hd V4769)))) (and (cons? V4770) (and (cons? (hd V4770)) (and (cons? (tl (hd V4770))) (= () (tl (tl (hd V4770))))))))))) (let W4771 (unwrap-ch (content-hash (hd (hd V4769)))) (let W4772 (unwrap-ch (content-hash (hd (hd V4770)))) (if (= W4771 W4772) (cons (cons (hd (hd V4769)) (cons (num-add (hd (tl (hd V4769))) (hd (tl (hd V4770)))) ())) (mono-mul (tl V4769) (tl V4770))) (if (< W4771 W4772) (cons (hd V4769) (mono-mul (tl V4769) V4770)) (cons (hd V4770) (mono-mul V4769 (tl V4770)))))))) (true (simple-error "partial function mono-mul")))) - -(defun poly-add (V4773 V4774) (canon-sort-poly (poly-add-raw V4773 V4774))) - -(defun poly-add-raw (V4775 V4776) (cond ((= () V4776) V4775) ((cons? V4776) (poly-add-raw (insert-term (hd V4776) V4775) (tl V4776))) (true (simple-error "partial function poly-add-raw")))) - -(defun insert-term (V4777 V4778) (cond ((and (cons? V4777) (and (cons? (tl V4777)) (and (= () (tl (tl V4777))) (= () V4778)))) (if (num-eq? (hd V4777) (cons int (cons 0 ()))) () (cons V4777 ()))) ((and (cons? V4777) (and (cons? (tl V4777)) (and (= () (tl (tl V4777))) (and (cons? V4778) (and (cons? (hd V4778)) (and (cons? (tl (hd V4778))) (= () (tl (tl (hd V4778)))))))))) (if (mono-eq? (hd (tl V4777)) (hd (tl (hd V4778)))) (let W4779 (num-add (hd V4777) (hd (hd V4778))) (if (num-eq? W4779 (cons int (cons 0 ()))) (tl V4778) (cons (cons W4779 (tl (hd V4778))) (tl V4778)))) (cons (hd V4778) (insert-term V4777 (tl V4778))))) (true (simple-error "partial function insert-term")))) - -(defun mono-eq? (V4784 V4785) (cond ((and (= () V4784) (= () V4785)) true) ((and (cons? V4784) (and (cons? (hd V4784)) (and (cons? (tl (hd V4784))) (and (= () (tl (tl (hd V4784)))) (and (cons? V4785) (and (cons? (hd V4785)) (and (cons? (tl (hd V4785))) (= () (tl (tl (hd V4785))))))))))) (if (content-eq (hd (hd V4784)) (hd (hd V4785))) (if (num-eq? (hd (tl (hd V4784))) (hd (tl (hd V4785)))) (mono-eq? (tl V4784) (tl V4785)) false) false)) (true false))) - -(defun poly-mul (V4790 V4791) (cond ((= () V4790) ()) ((= () V4791) ()) (true (canon-sort-poly (poly-mul-raw V4790 V4791 ()))))) - -(defun poly-mul-raw (V4794 V4795 V4796) (cond ((= () V4794) V4796) ((cons? V4794) (poly-mul-raw (tl V4794) V4795 (poly-add-raw V4796 (term-times-poly (hd V4794) V4795)))) (true (simple-error "partial function poly-mul-raw")))) - -(defun term-times-poly (V4799 V4800) (cond ((= () V4800) ()) ((and (cons? V4799) (and (cons? (tl V4799)) (and (= () (tl (tl V4799))) (and (cons? V4800) (and (cons? (hd V4800)) (and (cons? (tl (hd V4800))) (= () (tl (tl (hd V4800)))))))))) (cons (cons (num-mul (hd V4799) (hd (hd V4800))) (cons (mono-mul (hd (tl V4799)) (hd (tl (hd V4800)))) ())) (term-times-poly V4799 (tl V4800)))) (true (simple-error "partial function term-times-poly")))) - -(defun poly-pow (V4803 V4804) (cond ((= 0 V4804) (one-poly)) (true (poly-mul V4803 (poly-pow V4803 (- V4804 1)))))) - -(defun canon-sort-poly (V4805) (sort-terms V4805)) - -(defun sort-terms (V4806) (cond ((= () V4806) ()) ((cons? V4806) (insert-term-ordered (hd V4806) (sort-terms (tl V4806)))) (true (simple-error "partial function sort-terms")))) - -(defun insert-term-ordered (V4807 V4808) (cond ((= () V4808) (cons V4807 ())) ((cons? V4808) (if (term-before? V4807 (hd V4808)) (cons V4807 V4808) (cons (hd V4808) (insert-term-ordered V4807 (tl V4808))))) (true (simple-error "partial function insert-term-ordered")))) - -(defun mono-degree (V4813) (cond ((= () V4813) 0) ((and (cons? V4813) (and (cons? (hd V4813)) (and (cons? (tl (hd V4813))) (and (cons? (hd (tl (hd V4813)))) (and (= int (hd (hd (tl (hd V4813))))) (and (cons? (tl (hd (tl (hd V4813))))) (and (= () (tl (tl (hd (tl (hd V4813)))))) (= () (tl (tl (hd V4813))))))))))) (+ (hd (tl (hd (tl (hd V4813))))) (mono-degree (tl V4813)))) ((and (cons? V4813) (and (cons? (hd V4813)) (and (cons? (tl (hd V4813))) (= () (tl (tl (hd V4813))))))) (mono-degree (tl V4813))) (true (simple-error "partial function mono-degree")))) - -(defun term-before? (V4818 V4819) (cond ((and (cons? V4818) (and (cons? (tl V4818)) (and (= () (tl (tl V4818))) (and (cons? V4819) (and (cons? (tl V4819)) (= () (tl (tl V4819)))))))) (let W4820 (mono-degree (hd (tl V4818))) (let W4821 (mono-degree (hd (tl V4819))) (if (> W4820 W4821) true (if (< W4820 W4821) false (mono-lex-before? (hd (tl V4818)) (hd (tl V4819)))))))) (true (simple-error "partial function term-before?")))) - -(defun mono-lex-before? (V4826 V4827) (cond ((and (= () V4826) (= () V4827)) false) ((= () V4826) true) ((= () V4827) false) ((and (cons? V4826) (and (cons? (hd V4826)) (and (cons? (tl (hd V4826))) (and (= () (tl (tl (hd V4826)))) (and (cons? V4827) (and (cons? (hd V4827)) (and (cons? (tl (hd V4827))) (= () (tl (tl (hd V4827))))))))))) (let W4828 (unwrap-ch (content-hash (hd (hd V4826)))) (let W4829 (unwrap-ch (content-hash (hd (hd V4827)))) (if (< W4828 W4829) true (if (> W4828 W4829) false (let W4830 (exp-int (hd (tl (hd V4826)))) (let W4831 (exp-int (hd (tl (hd V4827)))) (if (< W4830 W4831) true (if (> W4830 W4831) false (mono-lex-before? (tl V4826) (tl V4827))))))))))) (true (simple-error "partial function mono-lex-before?")))) - -(defun exp-int (V4834) (cond ((and (cons? V4834) (and (= int (hd V4834)) (and (cons? (tl V4834)) (= () (tl (tl V4834)))))) (hd (tl V4834))) (true 0))) - -(defun poly->expr (V4835) (cond ((= () V4835) (cons int (cons 0 ()))) (true (terms->expr V4835)))) - -(defun terms->expr (V4836) (cond ((and (cons? V4836) (= () (tl V4836))) (term->expr (hd V4836))) (true (cons (poly-ct-plus) (map (lambda Z4837 (term->expr Z4837)) V4836))))) - -(defun term->expr (V4838) (cond ((and (cons? V4838) (and (cons? (tl V4838)) (and (= () (hd (tl V4838))) (= () (tl (tl V4838)))))) (hd V4838)) ((and (cons? V4838) (and (cons? (tl V4838)) (= () (tl (tl V4838))))) (let W4839 (mono->factors (hd (tl V4838))) (if (num-eq? (hd V4838) (cons int (cons 1 ()))) (factors->expr W4839) (factors->expr (cons (hd V4838) W4839))))) (true (simple-error "partial function term->expr")))) - -(defun mono->factors (V4840) (cond ((= () V4840) ()) ((and (cons? V4840) (and (cons? (hd V4840)) (and (cons? (tl (hd V4840))) (and (cons? (hd (tl (hd V4840)))) (and (= int (hd (hd (tl (hd V4840))))) (and (cons? (tl (hd (tl (hd V4840))))) (and (= 1 (hd (tl (hd (tl (hd V4840)))))) (and (= () (tl (tl (hd (tl (hd V4840)))))) (= () (tl (tl (hd V4840)))))))))))) (cons (hd (hd V4840)) (mono->factors (tl V4840)))) ((and (cons? V4840) (and (cons? (hd V4840)) (and (cons? (tl (hd V4840))) (= () (tl (tl (hd V4840))))))) (cons (cons (poly-ct-power) (hd V4840)) (mono->factors (tl V4840)))) (true (simple-error "partial function mono->factors")))) - -(defun factors->expr (V4841) (cond ((= () V4841) (cons int (cons 1 ()))) ((and (cons? V4841) (= () (tl V4841))) (hd V4841)) (true (cons (poly-ct-times) V4841)))) - -(defun poly-expand (V4842) (poly->expr (expr->poly V4842))) - -(defun polynomial-q? (V4843 V4844) (if (numeric? V4843) true (poly-q-nonnum V4843 V4844))) - -(defun poly-q-nonnum (V4845 V4846) (if (content-eq V4845 V4846) true (if (free-of? V4845 V4846) true (poly-q-structural V4845 V4846)))) - -(defun poly-q-structural (V4849 V4850) (cond ((cons? V4849) (poly-q-head (hd V4849) (tl V4849) V4850)) (true false))) - -(defun poly-q-head (V4851 V4852 V4853) (if (or (poly-plus-head? V4851) (poly-times-head? V4851)) (poly-q-args V4852 V4853) (if (poly-power-head? V4851) (poly-q-power V4852 V4853) false))) - -(defun poly-q-args (V4854 V4855) (cond ((= () V4854) true) ((cons? V4854) (if (polynomial-q? (hd V4854) V4855) (poly-q-args (tl V4854) V4855) false)) (true (simple-error "partial function poly-q-args")))) - -(defun poly-q-power (V4858 V4859) (cond ((and (cons? V4858) (and (cons? (tl V4858)) (= () (tl (tl V4858))))) (if (nonneg-int-exp? (hd (tl V4858))) (polynomial-q? (hd V4858) V4859) false)) (true false))) - -(pr "poly.shen loaded (expr<->poly, Expand + PolynomialQ). -" (stoutput)) - -(defun dedup-syms (V4860) (cond ((= () V4860) ()) ((cons? V4860) (if (element? (hd V4860) (dedup-syms (tl V4860))) (dedup-syms (tl V4860)) (cons (hd V4860) (dedup-syms (tl V4860))))) (true (simple-error "partial function dedup-syms")))) - -(defun indet-names (V4871) (cond ((and (cons? V4871) (and (= sym (hd V4871)) (and (cons? (tl V4871)) (= () (tl (tl V4871)))))) (tl V4871)) ((and (cons? V4871) (and (= int (hd V4871)) (and (cons? (tl V4871)) (= () (tl (tl V4871)))))) ()) ((and (cons? V4871) (and (= rat (hd V4871)) (and (cons? (tl V4871)) (and (cons? (tl (tl V4871))) (= () (tl (tl (tl V4871)))))))) ()) ((cons? V4871) (indet-names-list (tl V4871))) (true ()))) - -(defun indet-names-list (V4872) (cond ((= () V4872) ()) ((cons? V4872) (append (indet-names (hd V4872)) (indet-names-list (tl V4872)))) (true (simple-error "partial function indet-names-list")))) - -(defun free-sym-names (V4873) (dedup-syms (indet-names V4873))) - -(defun single-var (V4874) (let W4875 (free-sym-names V4874) (if (= (length W4875) 1) (cons some (cons (cons sym (cons (hd W4875) ())) ())) (cons none ())))) - -(defun term-exp-in (V4882 V4883) (cond ((and (cons? V4883) (and (cons? (tl V4883)) (and (= () (hd (tl V4883))) (= () (tl (tl V4883)))))) 0) ((and (cons? V4883) (and (cons? (tl V4883)) (and (cons? (hd (tl V4883))) (and (cons? (hd (hd (tl V4883)))) (and (cons? (tl (hd (hd (tl V4883))))) (and (cons? (hd (tl (hd (hd (tl V4883)))))) (and (= int (hd (hd (tl (hd (hd (tl V4883))))))) (and (cons? (tl (hd (tl (hd (hd (tl V4883))))))) (and (= () (tl (tl (hd (tl (hd (hd (tl V4883)))))))) (and (= () (tl (tl (hd (hd (tl V4883)))))) (and (= () (tl (hd (tl V4883)))) (= () (tl (tl V4883)))))))))))))) (if (content-eq (hd (hd (hd (tl V4883)))) V4882) (hd (tl (hd (tl (hd (hd (tl V4883))))))) (cons bad ()))) (true (cons bad ())))) - -(defun poly->coeffs (V4884 V4885) (let W4886 (poly-max-deg V4884 V4885) (if (= W4886 (cons bad ())) (cons none ()) (cons some (cons (coeffs-fill V4884 V4885 W4886) ()))))) - -(defun poly-max-deg (V4887 V4888) (cond ((= () V4888) 0) ((cons? V4888) (let W4889 (term-exp-in V4887 (hd V4888)) (if (= W4889 (cons bad ())) (cons bad ()) (let W4890 (poly-max-deg V4887 (tl V4888)) (if (= W4890 (cons bad ())) (cons bad ()) (max W4889 W4890)))))) (true (simple-error "partial function poly-max-deg")))) - -(defun max (V4891 V4892) (if (> V4891 V4892) V4891 V4892)) - -(defun coeffs-fill (V4893 V4894 V4895) (coeffs-loop V4893 V4894 0 V4895)) - -(defun coeffs-loop (V4896 V4897 V4898 V4899) (if (> V4898 V4899) () (cons (coeff-at-deg V4896 V4897 V4898) (coeffs-loop V4896 V4897 (+ V4898 1) V4899)))) - -(defun coeff-at-deg (V4902 V4903 V4904) (cond ((= () V4903) (cons int (cons 0 ()))) ((cons? V4903) (let W4905 (term-exp-in V4902 (hd V4903)) (if (= W4905 V4904) (term-coeff (hd V4903)) (coeff-at-deg V4902 (tl V4903) V4904)))) (true (simple-error "partial function coeff-at-deg")))) - -(defun coeffs->poly (V4906 V4907) (canon-sort-poly (coeffs->terms V4906 V4907 0))) - -(defun coeffs->terms (V4910 V4911 V4912) (cond ((= () V4911) ()) ((cons? V4911) (if (num-eq? (hd V4911) (cons int (cons 0 ()))) (coeffs->terms V4910 (tl V4911) (+ V4912 1)) (cons (coeff->term V4910 (hd V4911) V4912) (coeffs->terms V4910 (tl V4911) (+ V4912 1))))) (true (simple-error "partial function coeffs->terms")))) - -(defun coeff->term (V4913 V4914 V4915) (cond ((= 0 V4915) (cons V4914 (cons () ()))) (true (cons V4914 (cons (cons (cons V4913 (cons (cons int (cons V4915 ())) ())) ()) ()))))) - -(defun trim-coeffs (V4916) (reverse (drop-leading-zeros (reverse V4916)))) - -(defun drop-leading-zeros (V4917) (cond ((= () V4917) ()) ((cons? V4917) (if (num-eq? (hd V4917) (cons int (cons 0 ()))) (drop-leading-zeros (tl V4917)) V4917)) (true (simple-error "partial function drop-leading-zeros")))) - -(defun coeffs-deg (V4918) (let W4919 (trim-coeffs V4918) (- (length W4919) 1))) - -(defun coeffs-lead (V4920) (let W4921 (trim-coeffs V4920) (if (empty? W4921) (cons int (cons 0 ())) (last-of W4921)))) - -(defun last-of (V4924) (cond ((and (cons? V4924) (= () (tl V4924))) (hd V4924)) ((cons? V4924) (last-of (tl V4924))) (true (simple-error "partial function last-of")))) - -(defun expr->coeffs (V4925 V4926) (poly->coeffs V4925 (expr->poly V4926))) - -(defun vec-add (V4927 V4928) (cond ((= () V4927) V4928) ((= () V4928) V4927) ((and (cons? V4927) (cons? V4928)) (cons (num-add (hd V4927) (hd V4928)) (vec-add (tl V4927) (tl V4928)))) (true (simple-error "partial function vec-add")))) - -(defun vec-sub (V4929 V4930) (vec-add V4929 (vec-neg V4930))) - -(defun vec-neg (V4931) (cond ((= () V4931) ()) ((cons? V4931) (cons (num-mul (cons int (cons -1 ())) (hd V4931)) (vec-neg (tl V4931)))) (true (simple-error "partial function vec-neg")))) - -(defun vec-scale (V4932 V4933) (cond ((= () V4933) ()) ((cons? V4933) (cons (num-mul V4932 (hd V4933)) (vec-scale V4932 (tl V4933)))) (true (simple-error "partial function vec-scale")))) - -(defun vec-shift (V4934 V4935) (cond ((= 0 V4934) V4935) (true (cons (cons int (cons 0 ())) (vec-shift (- V4934 1) V4935))))) - -(defun vec-mul (V4940 V4941) (cond ((= () V4940) ()) ((= () V4941) ()) (true (vec-mul-loop V4940 V4941 0)))) - -(defun vec-mul-loop (V4946 V4947 V4948) (cond ((= () V4946) ()) ((cons? V4946) (vec-add (vec-shift V4948 (vec-scale (hd V4946) V4947)) (vec-mul-loop (tl V4946) V4947 (+ V4948 1)))) (true (simple-error "partial function vec-mul-loop")))) - -(defun uni-divmod (V4949 V4950) (let W4951 (trim-coeffs V4950) (if (empty? W4951) (simple-error "uni-divmod: zero divisor") (divmod-loop (trim-coeffs V4949) W4951 ())))) - -(defun divmod-loop (V4952 V4953 V4954) (let W4955 (trim-coeffs V4952) (let W4956 (coeffs-deg W4955) (let W4957 (coeffs-deg V4953) (if (< W4956 W4957) (cons (qacc->vec V4954) (cons W4955 ())) (let W4958 (coeffs-lead W4955) (let W4959 (coeffs-lead V4953) (let W4960 (num-div W4958 W4959) (let W4961 (- W4956 W4957) (let W4962 (vec-shift W4961 (vec-scale W4960 V4953)) (let W4963 (vec-sub W4955 W4962) (divmod-loop W4963 V4953 (cons (cons W4961 (cons W4960 ())) V4954))))))))))))) - -(defun qacc->vec (V4964) (cond ((= () V4964) ()) (true (qacc-fill V4964 (qacc-maxdeg V4964 0) 0)))) - -(defun qacc-maxdeg (V4967 V4968) (cond ((= () V4967) V4968) ((and (cons? V4967) (and (cons? (hd V4967)) (and (cons? (tl (hd V4967))) (= () (tl (tl (hd V4967))))))) (qacc-maxdeg (tl V4967) (max (hd (hd V4967)) V4968))) (true (simple-error "partial function qacc-maxdeg")))) - -(defun qacc-fill (V4969 V4970 V4971) (if (> V4971 V4970) () (cons (qacc-at V4969 V4971) (qacc-fill V4969 V4970 (+ V4971 1))))) - -(defun qacc-at (V4974 V4975) (cond ((= () V4974) (cons int (cons 0 ()))) ((and (cons? V4974) (and (cons? (hd V4974)) (and (cons? (tl (hd V4974))) (= () (tl (tl (hd V4974))))))) (if (= (hd (hd V4974)) V4975) (hd (tl (hd V4974))) (qacc-at (tl V4974) V4975))) (true (simple-error "partial function qacc-at")))) - -(defun uni-rem (V4976 V4977) (hd (tl (uni-divmod V4976 V4977)))) - -(defun zero-vec? (V4978) (empty? (trim-coeffs V4978))) - -(defun uni-gcd (V4979 V4980) (gcd-loop (trim-coeffs V4979) (trim-coeffs V4980))) - -(defun gcd-loop (V4981 V4982) (cond ((= () V4982) (make-monic V4981)) (true (gcd-loop V4982 (uni-rem V4981 V4982))))) - -(defun make-monic (V4983) (let W4984 (trim-coeffs V4983) (if (empty? W4984) () (vec-scale (num-div (cons int (cons 1 ())) (coeffs-lead W4984)) W4984)))) - -(defun vec-deriv (V4985) (deriv-loop (trim-coeffs V4985) 1)) - -(defun deriv-loop (V4994 V4995) (cond ((= () V4994) ()) ((and (cons? V4994) (= () (tl V4994))) ()) ((and (cons? V4994) (cons? (tl V4994))) (deriv-build (tl V4994) V4995)) (true (simple-error "partial function deriv-loop")))) - -(defun deriv-build (V4998 V4999) (cond ((= () V4998) ()) ((cons? V4998) (cons (num-mul (cons int (cons V4999 ())) (hd V4998)) (deriv-build (tl V4998) (+ V4999 1)))) (true (simple-error "partial function deriv-build")))) - -(defun coeffs->expr (V5000 V5001) (poly->expr (coeffs->poly V5000 (trim-coeffs V5001)))) - -(defun pa-divide-head? (V5004) (cond ((and (cons? V5004) (and (= sym (hd V5004)) (and (cons? (tl V5004)) (= () (tl (tl V5004)))))) (= (str (hd (tl V5004))) "Divide")) (true false))) - -(defun pa-times-head? (V5007) (cond ((and (cons? V5007) (and (= sym (hd V5007)) (and (cons? (tl V5007)) (= () (tl (tl V5007)))))) (= (str (hd (tl V5007))) "Times")) (true false))) - -(defun pa-plus-head? (V5010) (cond ((and (cons? V5010) (and (= sym (hd V5010)) (and (cons? (tl V5010)) (= () (tl (tl V5010)))))) (= (str (hd (tl V5010))) "Plus")) (true false))) - -(defun pa-power-head? (V5013) (cond ((and (cons? V5013) (and (= sym (hd V5013)) (and (cons? (tl V5013)) (= () (tl (tl V5013)))))) (= (str (hd (tl V5013))) "Power")) (true false))) - -(defun pa-divide () (cons sym (cons Divide ()))) - -(defun pa-times () (cons sym (cons Times ()))) - -(defun pa-plus () (cons sym (cons Plus ()))) - -(defun pa-power () (cons sym (cons Power ()))) - -(defun poly-gcd-builtin (V5014 V5015) (trap-error (poly-gcd-attempt V5014 V5015) (lambda Z5016 (cons none ())))) - -(defun poly-gcd-attempt (V5017 V5018) (let W5019 (gcd-shared-var V5017 V5018) (if (= W5019 (cons none ())) (cons none ()) (gcd-with-var (hd (tl W5019)) V5017 V5018)))) - -(defun gcd-shared-var (V5020 V5021) (let W5022 (free-sym-names V5020) (let W5023 (free-sym-names V5021) (let W5024 (dedup-syms (append W5022 W5023)) (if (> (length W5024) 1) (cons none ()) (if (empty? W5024) (cons none ()) (cons some (cons (cons sym (cons (hd W5024) ())) ())))))))) - -(defun gcd-with-var (V5025 V5026 V5027) (let W5028 (expr->coeffs V5025 V5026) (let W5029 (expr->coeffs V5025 V5027) (if (or (= W5028 (cons none ())) (= W5029 (cons none ()))) (cons none ()) (gcd-from-coeffs V5025 (hd (tl W5028)) (hd (tl W5029))))))) - -(defun gcd-from-coeffs (V5030 V5031 V5032) (let W5033 (uni-gcd V5031 V5032) (if (zero-vec? W5033) (cons none ()) (if (and (gcd-divides? V5031 W5033) (gcd-divides? V5032 W5033)) (cons some (cons (coeffs->expr V5030 W5033) ())) (cons none ()))))) - -(defun gcd-divides? (V5034 V5035) (zero-vec? (uni-rem V5034 V5035))) - -(defun cancel-builtin (V5036) (trap-error (cancel-attempt V5036) (lambda Z5037 (cons none ())))) - -(defun cancel-attempt (V5040) (cond ((and (cons? V5040) (and (cons? (tl V5040)) (and (cons? (tl (tl V5040))) (= () (tl (tl (tl V5040))))))) (if (pa-divide-head? (hd V5040)) (cancel-ratio (hd (tl V5040)) (hd (tl (tl V5040)))) (cons none ()))) (true (cons none ())))) - -(defun cancel-ratio (V5041 V5042) (let W5043 (gcd-shared-var V5041 V5042) (if (= W5043 (cons none ())) (cons none ()) (cancel-with-var (hd (tl W5043)) V5041 V5042)))) - -(defun cancel-with-var (V5044 V5045 V5046) (let W5047 (expr->coeffs V5044 V5045) (let W5048 (expr->coeffs V5044 V5046) (if (or (= W5047 (cons none ())) (= W5048 (cons none ()))) (cons none ()) (cancel-from-coeffs V5044 (hd (tl W5047)) (hd (tl W5048))))))) - -(defun cancel-from-coeffs (V5049 V5050 V5051) (let W5052 (uni-gcd V5050 V5051) (if (zero-vec? W5052) (cons none ()) (let W5053 (uni-divmod V5050 W5052) (let W5054 (uni-divmod V5051 W5052) (let W5055 (hd W5053) (let W5056 (hd (tl W5053)) (let W5057 (hd W5054) (let W5058 (hd (tl W5054)) (if (and (zero-vec? W5056) (zero-vec? W5058)) (cancel-build V5049 W5055 W5057) (cons none ()))))))))))) - -(defun cancel-build (V5059 V5060 V5061) (let W5062 (trim-coeffs V5061) (if (and (= (coeffs-deg W5062) 0) (num-eq? (coeffs-lead W5062) (cons int (cons 1 ())))) (cons some (cons (coeffs->expr V5059 V5060) ())) (cons some (cons (cons (pa-divide) (cons (coeffs->expr V5059 V5060) (cons (coeffs->expr V5059 V5061) ()))) ()))))) - -(defun together-builtin (V5063) (trap-error (together-attempt V5063) (lambda Z5064 (cons none ())))) - -(defun together-attempt (V5067) (cond ((cons? V5067) (if (pa-plus-head? (hd V5067)) (together-plus (tl V5067)) (cons none ()))) (true (cons none ())))) - -(defun together-plus (V5068) (let W5069 (together-var V5068) (if (= W5069 (cons none ())) (cons none ()) (together-with-var (hd (tl W5069)) V5068)))) - -(defun together-var (V5070) (let W5071 (dedup-syms (free-syms-of-list V5070)) (if (> (length W5071) 1) (cons none ()) (if (empty? W5071) (cons none ()) (cons some (cons (cons sym (cons (hd W5071) ())) ())))))) - -(defun free-syms-of-list (V5072) (cond ((= () V5072) ()) ((cons? V5072) (append (free-sym-names (hd V5072)) (free-syms-of-list (tl V5072)))) (true (simple-error "partial function free-syms-of-list")))) - -(defun together-with-var (V5073 V5074) (let W5075 (addends->fracs V5073 V5074 ()) (if (= W5075 (cons none ())) (cons none ()) (together-combine V5073 (hd (tl W5075)))))) - -(defun addends->fracs (V5076 V5077 V5078) (cond ((= () V5077) (cons some (cons (reverse V5078) ()))) ((cons? V5077) (let W5079 (addend->frac V5076 (hd V5077)) (if (= W5079 (cons none ())) (cons none ()) (addends->fracs V5076 (tl V5077) (cons (hd (tl W5079)) V5078))))) (true (simple-error "partial function addends->fracs")))) - -(defun addend->frac (V5080 V5081) (cond ((and (cons? V5081) (and (cons? (tl V5081)) (and (cons? (tl (tl V5081))) (= () (tl (tl (tl V5081))))))) (addend-divide V5080 (hd V5081) (hd (tl V5081)) (hd (tl (tl V5081))))) (true (addend-poly V5080 V5081)))) - -(defun addend-divide (V5082 V5083 V5084 V5085) (if (pa-divide-head? V5083) (let W5086 (expr->coeffs V5082 V5084) (let W5087 (expr->coeffs V5082 V5085) (if (or (= W5086 (cons none ())) (= W5087 (cons none ()))) (cons none ()) (cons some (cons (cons (hd (tl W5086)) (cons (hd (tl W5087)) ())) ()))))) (addend-poly V5082 (cons V5083 (cons V5084 (cons V5085 ())))))) - -(defun addend-poly (V5088 V5089) (let W5090 (expr->coeffs V5088 V5089) (if (= W5090 (cons none ())) (cons none ()) (cons some (cons (cons (hd (tl W5090)) (cons (cons (cons int (cons 1 ())) ()) ())) ()))))) - -(defun together-combine (V5091 V5092) (let W5093 (sum-fracs V5092) (let W5094 (hd W5093) (let W5095 (hd (tl W5093)) (together-emit V5091 W5094 W5095))))) - -(defun sum-fracs (V5096) (cond ((and (cons? V5096) (= () (tl V5096))) (hd V5096)) ((cons? V5096) (add-frac (hd V5096) (sum-fracs (tl V5096)))) (true (simple-error "partial function sum-fracs")))) - -(defun add-frac (V5097 V5098) (cond ((and (cons? V5097) (and (cons? (tl V5097)) (and (= () (tl (tl V5097))) (and (cons? V5098) (and (cons? (tl V5098)) (= () (tl (tl V5098)))))))) (cons (vec-add (vec-mul (hd V5097) (hd (tl V5098))) (vec-mul (hd V5098) (hd (tl V5097)))) (cons (vec-mul (hd (tl V5097)) (hd (tl V5098))) ()))) (true (simple-error "partial function add-frac")))) - -(defun together-emit (V5099 V5100 V5101) (let W5102 (uni-gcd V5100 V5101) (if (zero-vec? W5102) (cons some (cons (coeffs->expr V5099 V5100) ())) (let W5103 (hd (uni-divmod V5100 W5102)) (let W5104 (hd (uni-divmod V5101 W5102)) (together-emit-norm V5099 W5103 W5104)))))) - -(defun together-emit-norm (V5105 V5106 V5107) (let W5108 (trim-coeffs V5107) (let W5109 (coeffs-lead W5108) (let W5110 (if (num-neg? W5109) (cons int (cons -1 ())) (cons int (cons 1 ()))) (let W5111 (vec-scale W5110 V5106) (let W5112 (vec-scale W5110 W5108) (if (and (= (coeffs-deg W5112) 0) (num-eq? (coeffs-lead W5112) (cons int (cons 1 ())))) (cons some (cons (coeffs->expr V5105 W5111) ())) (cons some (cons (cons (pa-divide) (cons (coeffs->expr V5105 W5111) (cons (coeffs->expr V5105 W5112) ()))) ()))))))))) - -(defun num-neg? (V5113) (< (rat-num (as-rat V5113)) 0)) - -(defun factor-builtin (V5114) (trap-error (factor-attempt V5114) (lambda Z5115 (cons none ())))) - -(defun factor-attempt (V5116) (let W5117 (single-var V5116) (if (= W5117 (cons none ())) (cons none ()) (factor-with-var (hd (tl W5117)) V5116)))) - -(defun factor-with-var (V5118 V5119) (let W5120 (expr->coeffs V5118 V5119) (if (= W5120 (cons none ())) (cons none ()) (factor-from-coeffs V5118 V5119 (trim-coeffs (hd (tl W5120))))))) - -(defun factor-from-coeffs (V5121 V5122 V5123) (if (< (coeffs-deg V5123) 1) (cons none ()) (let W5124 (factor-vec V5121 V5123) (factor-verify V5121 V5122 W5124)))) - -(defun factor-verify (V5125 V5126 V5127) (let W5128 (factors-product-expr V5127) (if (content-eq (poly-expand W5128) (poly-expand V5126)) (cons some (cons (factors->result V5127) ())) (cons none ())))) - -(defun factors-product-expr (V5129) (cond ((= () V5129) (cons int (cons 1 ()))) ((and (cons? V5129) (= () (tl V5129))) (hd V5129)) (true (cons (pa-times) V5129)))) - -(defun factors->result (V5130) (cond ((= () V5130) (cons int (cons 1 ()))) ((and (cons? V5130) (= () (tl V5130))) (hd V5130)) (true (cons (pa-times) V5130)))) - -(defun factor-vec (V5131 V5132) (let W5133 (vec-content V5132) (let W5134 (vec-scale (num-div (cons int (cons 1 ())) W5133) V5132) (let W5135 (if (num-eq? W5133 (cons int (cons 1 ()))) () (cons W5133 ())) (append W5135 (factor-sqfree-roots V5131 W5134)))))) - -(defun vec-content (V5136) (coeffs-lead V5136)) - -(defun factor-sqfree-roots (V5137 V5138) (let W5139 (rational-roots V5138) (extract-linear-factors V5137 (make-monic V5138) W5139))) - -(defun extract-linear-factors (V5140 V5141 V5142) (cond ((= () V5142) (leftover-factor V5140 V5141)) ((cons? V5142) (let W5143 (linear-vec (hd V5142)) (let W5144 (uni-divmod V5141 W5143) (let W5145 (hd W5144) (let W5146 (hd (tl W5144)) (if (zero-vec? W5146) (cons (linear-expr V5140 (hd V5142)) (extract-linear-factors V5140 W5145 V5142)) (extract-linear-factors V5140 V5141 (tl V5142)))))))) (true (simple-error "partial function extract-linear-factors")))) - -(defun leftover-factor (V5147 V5148) (let W5149 (trim-coeffs V5148) (if (< (coeffs-deg W5149) 1) (if (num-eq? (coeffs-lead W5149) (cons int (cons 1 ()))) () (cons (coeffs->expr V5147 W5149) ())) (cons (coeffs->expr V5147 W5149) ())))) - -(defun linear-vec (V5150) (cons (num-mul (cons int (cons -1 ())) V5150) (cons (cons int (cons 1 ())) ()))) - -(defun linear-expr (V5151 V5152) (coeffs->expr V5151 (linear-vec V5152))) - -(defun rational-roots (V5153) (let W5154 (clear-denoms V5153) (if (= W5154 (cons none ())) () (let W5155 (hd (tl W5154)) (let W5156 (rat-num (as-rat (hd W5155))) (let W5157 (rat-num (as-rat (last-of W5155))) (if (or (= W5156 0) (= W5157 0)) (roots-with-zero V5153) (candidate-roots V5153 W5156 W5157)))))))) - -(defun roots-with-zero (V5158) (cons (make-rat 0 1) (rational-roots (hd (uni-divmod V5158 (cons (cons int (cons 0 ())) (cons (cons int (cons 1 ())) ()))))))) - -(defun candidate-roots (V5159 V5160 V5161) (filter-roots V5159 (dedup-rats (gen-candidates (divisors (abs-num V5160)) (divisors (abs-num V5161)))))) - -(defun gen-candidates (V5162 V5163) (gen-cand-p V5162 V5163)) - -(defun gen-cand-p (V5166 V5167) (cond ((= () V5166) ()) ((cons? V5166) (append (gen-cand-q (hd V5166) V5167) (gen-cand-p (tl V5166) V5167))) (true (simple-error "partial function gen-cand-p")))) - -(defun gen-cand-q (V5170 V5171) (cond ((= () V5171) ()) ((cons? V5171) (cons (make-rat V5170 (hd V5171)) (cons (make-rat (- 0 V5170) (hd V5171)) (gen-cand-q V5170 (tl V5171))))) (true (simple-error "partial function gen-cand-q")))) - -(defun divisors (V5172) (if (<= V5172 0) (cons 1 ()) (divisors-loop V5172 1 ()))) - -(defun divisors-loop (V5173 V5174 V5175) (if (> V5174 V5173) (reverse V5175) (if (= (- V5173 (* (intdiv V5173 V5174) V5174)) 0) (divisors-loop V5173 (+ V5174 1) (cons V5174 V5175)) (divisors-loop V5173 (+ V5174 1) V5175)))) - -(defun dedup-rats (V5176) (cond ((= () V5176) ()) ((cons? V5176) (if (rat-member? (hd V5176) (tl V5176)) (dedup-rats (tl V5176)) (cons (hd V5176) (dedup-rats (tl V5176))))) (true (simple-error "partial function dedup-rats")))) - -(defun rat-member? (V5179 V5180) (cond ((= () V5180) false) ((cons? V5180) (if (num-eq? V5179 (hd V5180)) true (rat-member? V5179 (tl V5180)))) (true (simple-error "partial function rat-member?")))) - -(defun filter-roots (V5183 V5184) (cond ((= () V5184) ()) ((cons? V5184) (if (num-eq? (vec-eval V5183 (hd V5184)) (cons int (cons 0 ()))) (cons (hd V5184) (filter-roots V5183 (tl V5184))) (filter-roots V5183 (tl V5184)))) (true (simple-error "partial function filter-roots")))) - -(defun vec-eval (V5185 V5186) (vec-eval-loop (trim-coeffs V5185) V5186 (cons int (cons 1 ())) (cons int (cons 0 ())))) - -(defun vec-eval-loop (V5191 V5192 V5193 V5194) (cond ((= () V5191) V5194) ((cons? V5191) (vec-eval-loop (tl V5191) V5192 (num-mul V5193 V5192) (num-add V5194 (num-mul (hd V5191) V5193)))) (true (simple-error "partial function vec-eval-loop")))) - -(defun clear-denoms (V5195) (trap-error (cons some (cons (clear-denoms! (trim-coeffs V5195)) ())) (lambda Z5196 (cons none ())))) - -(defun clear-denoms! (V5197) (let W5198 (vec-lcm-denom V5197 1) (vec-clear V5197 W5198))) - -(defun vec-lcm-denom (V5199 V5200) (cond ((= () V5199) V5200) ((cons? V5199) (vec-lcm-denom (tl V5199) (lcm-int V5200 (rat-den (as-rat (hd V5199)))))) (true (simple-error "partial function vec-lcm-denom")))) - -(defun lcm-int (V5201 V5202) (intdiv (* V5201 V5202) (gcd V5201 V5202))) - -(defun vec-clear (V5205 V5206) (cond ((= () V5205) ()) ((cons? V5205) (cons (num-mul (hd V5205) (cons int (cons V5206 ()))) (vec-clear (tl V5205) V5206))) (true (simple-error "partial function vec-clear")))) - -(defun apart-builtin (V5207) (trap-error (apart-attempt V5207) (lambda Z5208 (cons none ())))) - -(defun apart-attempt (V5211) (cond ((and (cons? V5211) (and (cons? (tl V5211)) (and (cons? (tl (tl V5211))) (= () (tl (tl (tl V5211))))))) (if (pa-divide-head? (hd V5211)) (apart-on-divide (hd (tl V5211)) (hd (tl (tl V5211)))) (cons none ()))) (true (cons none ())))) - -(defun apart-on-divide (V5212 V5213) (apart-pick-var (gcd-shared-var V5212 V5213) V5212 V5213)) - -(defun apart-pick-var (V5214 V5215 V5216) (cond ((and (cons? V5214) (and (= some (hd V5214)) (and (cons? (tl V5214)) (= () (tl (tl V5214)))))) (apart-coeffs (hd (tl V5214)) (expr->coeffs (hd (tl V5214)) V5215) (expr->coeffs (hd (tl V5214)) V5216))) ((and (cons? V5214) (and (= none (hd V5214)) (= () (tl V5214)))) V5214) (true (simple-error "partial function apart-pick-var")))) - -(defun apart-coeffs (V5221 V5222 V5223) (cond ((and (cons? V5222) (and (= some (hd V5222)) (and (cons? (tl V5222)) (and (= () (tl (tl V5222))) (and (cons? V5223) (and (= some (hd V5223)) (and (cons? (tl V5223)) (= () (tl (tl V5223)))))))))) (apart-monic V5221 (trim-coeffs (hd (tl V5222))) (trim-coeffs (hd (tl V5223))))) (true (cons none ())))) - -(defun apart-monic (V5224 V5225 V5226) (let W5227 (coeffs-lead V5226) (let W5228 (make-monic V5226) (let W5229 (vec-scale (num-div (cons int (cons 1 ())) W5227) V5225) (if (< (coeffs-deg W5229) (coeffs-deg W5228)) (apart-roots V5224 W5229 W5228 (rational-roots W5228)) (cons none ())))))) - -(defun apart-roots (V5230 V5231 V5232 V5233) (if (= (length V5233) (coeffs-deg V5232)) (if (vec-eq? (apart-prod V5233) V5232) (apart-gate V5230 (apart-terms V5231 V5233 V5233) V5231 V5232) (cons none ())) (cons none ()))) - -(defun apart-prod (V5234) (cond ((= () V5234) (cons (cons int (cons 1 ())) ())) ((cons? V5234) (vec-mul (linear-vec (hd V5234)) (apart-prod (tl V5234)))) (true (simple-error "partial function apart-prod")))) - -(defun apart-terms (V5239 V5240 V5241) (cond ((= () V5240) ()) ((cons? V5240) (cons (cons (apart-residue V5239 (hd V5240) V5241) (cons (linear-vec (hd V5240)) ())) (apart-terms V5239 (tl V5240) V5241))) (true (simple-error "partial function apart-terms")))) - -(defun apart-residue (V5242 V5243 V5244) (num-div (vec-eval V5242 V5243) (apart-proddiff V5243 V5244))) - -(defun apart-proddiff (V5247 V5248) (cond ((= () V5248) (cons int (cons 1 ()))) ((cons? V5248) (if (num-eq? V5247 (hd V5248)) (apart-proddiff V5247 (tl V5248)) (num-mul (num-sub V5247 (hd V5248)) (apart-proddiff V5247 (tl V5248))))) (true (simple-error "partial function apart-proddiff")))) - -(defun apart-gate (V5249 V5250 V5251 V5252) (apart-gate-2 V5249 V5250 V5251 V5252 (sum-fracs (apart-fracs V5250)))) - -(defun apart-fracs (V5253) (cond ((= () V5253) ()) ((and (cons? V5253) (and (cons? (hd V5253)) (and (cons? (tl (hd V5253))) (= () (tl (tl (hd V5253))))))) (cons (cons (cons (hd (hd V5253)) ()) (tl (hd V5253))) (apart-fracs (tl V5253)))) (true (simple-error "partial function apart-fracs")))) - -(defun apart-gate-2 (V5256 V5257 V5258 V5259 V5260) (cond ((and (cons? V5260) (and (cons? (tl V5260)) (= () (tl (tl V5260))))) (if (vec-eq? (hd V5260) V5258) (if (vec-eq? (hd (tl V5260)) V5259) (cons some (cons (apart-emit V5256 V5257) ())) (cons none ())) (cons none ()))) (true (cons none ())))) - -(defun apart-emit (V5261 V5262) (cond ((and (cons? V5262) (= () (tl V5262))) (apart-term V5261 (hd V5262))) (true (cons (pa-plus) (apart-emit-list V5261 V5262))))) - -(defun apart-emit-list (V5265 V5266) (cond ((= () V5266) ()) ((cons? V5266) (cons (apart-term V5265 (hd V5266)) (apart-emit-list V5265 (tl V5266)))) (true (simple-error "partial function apart-emit-list")))) - -(defun apart-term (V5267 V5268) (cond ((and (cons? V5268) (and (cons? (tl V5268)) (= () (tl (tl V5268))))) (if (num-eq? (hd V5268) (cons int (cons 1 ()))) (cons (pa-power) (cons (coeffs->expr V5267 (hd (tl V5268))) (cons (cons int (cons -1 ())) ()))) (cons (pa-times) (cons (hd V5268) (cons (cons (pa-power) (cons (coeffs->expr V5267 (hd (tl V5268))) (cons (cons int (cons -1 ())) ()))) ()))))) (true (simple-error "partial function apart-term")))) - -(defun vec-eq? (V5269 V5270) (vec-eq-loop (trim-coeffs V5269) (trim-coeffs V5270))) - -(defun vec-eq-loop (V5275 V5276) (cond ((and (= () V5275) (= () V5276)) true) ((= () V5275) false) ((= () V5276) false) ((and (cons? V5275) (cons? V5276)) (if (num-eq? (hd V5275) (hd V5276)) (vec-eq-loop (tl V5275) (tl V5276)) false)) (true (simple-error "partial function vec-eq-loop")))) - -(pr "polyalg.shen loaded (univariate Q: PolynomialGCD/Cancel/Together/Factor/Apart). -" (stoutput)) - -(defun sv-equal-head? (V5279) (cond ((and (cons? V5279) (and (= sym (hd V5279)) (and (cons? (tl V5279)) (= () (tl (tl V5279)))))) (= (str (hd (tl V5279))) "Equal")) (true false))) - -(defun sv-plus () (cons sym (cons Plus ()))) - -(defun sv-times () (cons sym (cons Times ()))) - -(defun sv-power () (cons sym (cons Power ()))) - -(defun sv-list () (cons sym (cons List ()))) - -(defun sv-sqrt () (cons sym (cons Sqrt ()))) - -(defun sv-head (V5284) (cond ((cons? V5284) (hd V5284)) (true (cons none ())))) - -(defun solve-builtin (V5285 V5286) (trap-error (solve-attempt V5285 V5286) (lambda Z5287 (cons none ())))) - -(defun solve-attempt (V5290 V5291) (cond ((and (cons? V5291) (and (= sym (hd V5291)) (and (cons? (tl V5291)) (= () (tl (tl V5291)))))) (solve-with-var V5290 V5291)) (true (cons none ())))) - -(defun solve-with-var (V5292 V5293) (solve-poly (solve-normalize V5292) V5293)) - -(defun solve-normalize (V5294) (cond ((and (cons? V5294) (and (cons? (tl V5294)) (and (cons? (tl (tl V5294))) (= () (tl (tl (tl V5294))))))) (if (sv-equal-head? (hd V5294)) (cons (sv-plus) (cons (hd (tl V5294)) (cons (cons (sv-times) (cons (cons int (cons -1 ())) (tl (tl V5294)))) ()))) V5294)) (true V5294))) - -(defun solve-poly (V5295 V5296) (if (solve-univariate-in? V5295 V5296) (solve-coeffs V5295 V5296 (expr->coeffs V5296 V5295)) (cons none ()))) - -(defun solve-univariate-in? (V5297 V5298) (cond ((and (cons? V5298) (and (= sym (hd V5298)) (and (cons? (tl V5298)) (= () (tl (tl V5298)))))) (solve-names-subset? (free-sym-names V5297) (hd (tl V5298)))) (true (simple-error "partial function solve-univariate-in?")))) - -(defun solve-names-subset? (V5301 V5302) (cond ((= () V5301) true) ((cons? V5301) (if (= (hd V5301) V5302) (solve-names-subset? (tl V5301) V5302) false)) (true (simple-error "partial function solve-names-subset?")))) - -(defun solve-coeffs (V5307 V5308 V5309) (cond ((and (cons? V5309) (and (= none (hd V5309)) (= () (tl V5309)))) V5309) ((and (cons? V5309) (and (= some (hd V5309)) (and (cons? (tl V5309)) (= () (tl (tl V5309)))))) (solve-dispatch V5307 V5308 (trim-coeffs (hd (tl V5309))))) (true (simple-error "partial function solve-coeffs")))) - -(defun solve-dispatch (V5310 V5311 V5312) (let W5313 (coeffs-deg V5312) (if (= W5313 -1) (cons none ()) (if (= W5313 0) (cons some (cons (cons (sv-list) ()) ())) (if (= W5313 1) (solve-finish V5310 V5311 (solve-linear V5312)) (if (= W5313 2) (solve-finish V5310 V5311 (solve-quadratic V5312)) (solve-finish V5310 V5311 (solve-highdeg V5310 V5311 V5312)))))))) - -(defun solve-finish (V5318 V5319 V5320) (cond ((and (cons? V5320) (and (= none (hd V5320)) (= () (tl V5320)))) V5320) ((and (cons? V5320) (and (= some (hd V5320)) (and (cons? (tl V5320)) (= () (tl (tl V5320)))))) (solve-gate V5318 V5319 (sv-dedup-roots (hd (tl V5320))))) (true (simple-error "partial function solve-finish")))) - -(defun solve-linear (V5321) (let W5322 (hd V5321) (let W5323 (hd (tl V5321)) (cons some (cons (cons (num-div (num-mul (cons int (cons -1 ())) W5322) W5323) ()) ()))))) - -(defun solve-quadratic (V5324) (let W5325 (hd V5324) (let W5326 (hd (tl V5324)) (let W5327 (hd (tl (tl V5324))) (let W5328 (num-sub (num-mul W5326 W5326) (num-mul (cons int (cons 4 ())) (num-mul W5327 W5325))) (solve-quad-from-disc W5325 W5326 W5327 W5328)))))) - -(defun solve-quad-from-disc (V5329 V5330 V5331 V5332) (let W5333 (perfect-rat-sqrt V5332) (if (= W5333 (cons none ())) (solve-quad-symbolic V5330 V5331 V5332) (solve-quad-rational V5330 V5331 (hd (tl W5333)))))) - -(defun solve-quad-rational (V5334 V5335 V5336) (let W5337 (num-mul (cons int (cons 2 ())) V5335) (let W5338 (num-mul (cons int (cons -1 ())) V5334) (let W5339 (num-div (num-add W5338 V5336) W5337) (let W5340 (num-div (num-sub W5338 V5336) W5337) (cons some (cons (cons W5339 (cons W5340 ())) ()))))))) - -(defun solve-quad-symbolic (V5341 V5342 V5343) (let W5344 (num-mul (cons int (cons 2 ())) V5342) (let W5345 (num-mul (cons int (cons -1 ())) V5341) (let W5346 (sv-quad-root W5345 V5343 W5344 (cons int (cons 1 ()))) (let W5347 (sv-quad-root W5345 V5343 W5344 (cons int (cons -1 ()))) (cons some (cons (cons W5346 (cons W5347 ())) ()))))))) - -(defun sv-quad-root (V5348 V5349 V5350 V5351) (reduce (cons (sv-times) (cons (cons (sv-plus) (cons V5348 (cons (cons (sv-times) (cons V5351 (cons (cons (sv-sqrt) (cons V5349 ())) ()))) ()))) (cons (cons (sv-power) (cons V5350 (cons (cons int (cons -1 ())) ()))) ()))))) - -(defun perfect-rat-sqrt (V5352) (let W5353 (as-rat V5352) (let W5354 (rat-num W5353) (let W5355 (rat-den W5353) (if (< W5354 0) (cons none ()) (let W5356 (int-sqrt W5354) (let W5357 (int-sqrt W5355) (if (or (= W5356 (cons none ())) (= W5357 (cons none ()))) (cons none ()) (cons some (cons (make-rat (hd (tl W5356)) (hd (tl W5357))) ())))))))))) - -(defun int-sqrt (V5358) (cond ((= 0 V5358) (cons some (cons 0 ()))) (true (int-sqrt-loop V5358 1)))) - -(defun int-sqrt-loop (V5359 V5360) (let W5361 (* V5360 V5360) (if (= W5361 V5359) (cons some (cons V5360 ())) (if (> W5361 V5359) (cons none ()) (int-sqrt-loop V5359 (+ V5360 1)))))) - -(defun solve-highdeg (V5362 V5363 V5364) (let W5365 (factor-builtin V5362) (if (= W5365 (cons none ())) (cons none ()) (solve-factors V5363 (sv-factor-list (hd (tl W5365))))))) - -(defun sv-factor-list (V5366) (cond ((cons? V5366) (if (sv-times-head? (hd V5366)) (tl V5366) (cons V5366 ()))) (true (cons V5366 ())))) - -(defun sv-times-head? (V5369) (cond ((and (cons? V5369) (and (= sym (hd V5369)) (and (cons? (tl V5369)) (= () (tl (tl V5369)))))) (= (str (hd (tl V5369))) "Times")) (true false))) - -(defun solve-factors (V5370 V5371) (cond ((= () V5371) (cons some (cons () ()))) ((cons? V5371) (sv-merge-factor-roots (solve-one-factor V5370 (hd V5371)) V5370 (tl V5371))) (true (simple-error "partial function solve-factors")))) - -(defun sv-merge-factor-roots (V5376 V5377 V5378) (cond ((and (cons? V5376) (and (= none (hd V5376)) (= () (tl V5376)))) V5376) ((and (cons? V5376) (and (= some (hd V5376)) (and (cons? (tl V5376)) (= () (tl (tl V5376)))))) (sv-merge-rest (hd (tl V5376)) (solve-factors V5377 V5378))) (true (simple-error "partial function sv-merge-factor-roots")))) - -(defun sv-merge-rest (V5381 V5382) (cond ((and (cons? V5382) (and (= none (hd V5382)) (= () (tl V5382)))) V5382) ((and (cons? V5382) (and (= some (hd V5382)) (and (cons? (tl V5382)) (= () (tl (tl V5382)))))) (cons some (cons (append V5381 (hd (tl V5382))) ()))) (true (simple-error "partial function sv-merge-rest")))) - -(defun solve-one-factor (V5383 V5384) (if (numeric? V5384) (cons some (cons () ())) (if (free-of? V5384 V5383) (cons some (cons () ())) (solve-factor-coeffs V5383 V5384 (expr->coeffs V5383 V5384))))) - -(defun solve-factor-coeffs (V5385 V5386 V5387) (cond ((and (cons? V5387) (and (= none (hd V5387)) (= () (tl V5387)))) V5387) ((and (cons? V5387) (and (= some (hd V5387)) (and (cons? (tl V5387)) (= () (tl (tl V5387)))))) (solve-factor-by-deg V5385 (trim-coeffs (hd (tl V5387))))) (true (simple-error "partial function solve-factor-coeffs")))) - -(defun solve-factor-by-deg (V5388 V5389) (let W5390 (coeffs-deg V5389) (if (= W5390 1) (solve-linear V5389) (if (= W5390 2) (solve-quadratic V5389) (if (= W5390 0) (cons some (cons () ())) (cons none ())))))) - -(defun sv-dedup-roots (V5391) (cond ((= () V5391) ()) ((cons? V5391) (if (sv-root-member? (hd V5391) (tl V5391)) (sv-dedup-roots (tl V5391)) (cons (hd V5391) (sv-dedup-roots (tl V5391))))) (true (simple-error "partial function sv-dedup-roots")))) - -(defun sv-root-member? (V5394 V5395) (cond ((= () V5395) false) ((cons? V5395) (if (content-eq V5394 (hd V5395)) true (sv-root-member? V5394 (tl V5395)))) (true (simple-error "partial function sv-root-member?")))) - -(defun solve-gate (V5396 V5397 V5398) (if (sv-verify-all V5396 V5397 V5398) (cons some (cons (cons (sv-list) V5398) ())) (cons none ()))) - -(defun sv-verify-all (V5403 V5404 V5405) (cond ((= () V5405) true) ((cons? V5405) (if (sv-verify-one V5403 V5404 (hd V5405)) (sv-verify-all V5403 V5404 (tl V5405)) false)) (true (simple-error "partial function sv-verify-all")))) - -(defun sv-verify-one (V5406 V5407 V5408) (sv-zero? (reduce (sv-subst V5407 V5408 V5406)))) - -(defun sv-zero? (V5409) (if (numeric? V5409) (num-eq? V5409 (cons int (cons 0 ()))) false)) - -(defun sv-subst (V5410 V5411 V5412) (cond ((and (cons? V5412) (and (= sym (hd V5412)) (and (cons? (tl V5412)) (= () (tl (tl V5412)))))) (if (content-eq V5410 V5412) V5411 V5412)) ((and (cons? V5412) (and (= int (hd V5412)) (and (cons? (tl V5412)) (= () (tl (tl V5412)))))) V5412) ((and (cons? V5412) (and (= rat (hd V5412)) (and (cons? (tl V5412)) (and (cons? (tl (tl V5412))) (= () (tl (tl (tl V5412)))))))) V5412) ((cons? V5412) (cons (sv-subst V5410 V5411 (hd V5412)) (sv-subst-list V5410 V5411 (tl V5412)))) (true V5412))) - -(defun sv-subst-list (V5413 V5414 V5415) (cond ((= () V5415) ()) ((cons? V5415) (cons (sv-subst V5413 V5414 (hd V5415)) (sv-subst-list V5413 V5414 (tl V5415)))) (true (simple-error "partial function sv-subst-list")))) - -(pr "solve.shen loaded (Wave D: Solve polynomial equations in one var over Q). -" (stoutput)) - -(defun se-plus () (cons sym (cons Plus ()))) - -(defun se-times () (cons sym (cons Times ()))) - -(defun se-power () (cons sym (cons Power ()))) - -(defun se-d () (cons sym (cons D ()))) - -(defun se-head-name (V5418) (cond ((and (cons? V5418) (and (= sym (hd V5418)) (and (cons? (tl V5418)) (= () (tl (tl V5418)))))) (str (hd (tl V5418)))) (true ""))) - -(defun se-divide-head? (V5421) (cond ((and (cons? V5421) (and (= sym (hd V5421)) (and (cons? (tl V5421)) (= () (tl (tl V5421)))))) (= (str (hd (tl V5421))) "Divide")) (true false))) - -(defun se-subst (V5422 V5423 V5424) (cond ((and (cons? V5424) (and (= sym (hd V5424)) (and (cons? (tl V5424)) (= () (tl (tl V5424)))))) (if (content-eq V5422 V5424) V5423 V5424)) ((and (cons? V5424) (and (= int (hd V5424)) (and (cons? (tl V5424)) (= () (tl (tl V5424)))))) V5424) ((and (cons? V5424) (and (= rat (hd V5424)) (and (cons? (tl V5424)) (and (cons? (tl (tl V5424))) (= () (tl (tl (tl V5424)))))))) V5424) ((cons? V5424) (cons (se-subst V5422 V5423 (hd V5424)) (se-subst-list V5422 V5423 (tl V5424)))) (true V5424))) - -(defun se-subst-list (V5425 V5426 V5427) (cond ((= () V5427) ()) ((cons? V5427) (cons (se-subst V5425 V5426 (hd V5427)) (se-subst-list V5425 V5426 (tl V5427)))) (true (simple-error "partial function se-subst-list")))) - -(defun se-factorial (V5428) (trap-error (cons some (cons (se-fact-loop V5428 1) ())) (lambda Z5429 (cons none ())))) - -(defun se-fact-loop (V5430 V5431) (cond ((= 0 V5430) V5431) (true (se-fact-loop (- V5430 1) (se-guard-mul V5431 V5430))))) - -(defun se-guard-mul (V5432 V5433) (guard-int (* V5432 V5433))) - -(defun se-numeric? (V5434) (numeric? V5434)) - -(defun series-builtin (V5435) (trap-error (series-attempt V5435) (lambda Z5436 (cons none ())))) - -(defun series-attempt (V5439) (cond ((and (cons? V5439) (and (cons? (tl V5439)) (and (cons? (hd (tl V5439))) (and (= sym (hd (hd (tl V5439)))) (and (cons? (tl (hd (tl V5439)))) (and (= () (tl (tl (hd (tl V5439))))) (and (cons? (tl (tl V5439))) (= () (tl (tl (tl V5439))))))))))) (series-go (hd V5439) (hd (tl V5439)) (cons int (cons 0 ())) (hd (tl (tl V5439))))) ((and (cons? V5439) (and (cons? (tl V5439)) (and (cons? (hd (tl V5439))) (and (= sym (hd (hd (tl V5439)))) (and (cons? (tl (hd (tl V5439)))) (and (= () (tl (tl (hd (tl V5439))))) (and (cons? (tl (tl V5439))) (and (cons? (tl (tl (tl V5439)))) (= () (tl (tl (tl (tl V5439))))))))))))) (series-go (hd V5439) (hd (tl V5439)) (hd (tl (tl V5439))) (hd (tl (tl (tl V5439)))))) (true (cons none ())))) - -(defun series-go (V5442 V5443 V5444 V5445) (cond ((and (cons? V5445) (and (= int (hd V5445)) (and (cons? (tl V5445)) (= () (tl (tl V5445)))))) (if (< (hd (tl V5445)) 0) (cons none ()) (series-build V5442 V5443 V5444 (hd (tl V5445))))) (true (cons none ())))) - -(defun series-build (V5446 V5447 V5448 V5449) (let W5450 (series-terms V5446 V5447 V5448 0 V5449 V5446 ()) (if (= W5450 (cons none ())) (cons none ()) (cons some (cons (series-sum (reverse W5450)) ()))))) - -(defun series-terms (V5451 V5452 V5453 V5454 V5455 V5456 V5457) (if (> V5454 V5455) V5457 (series-term-k V5451 V5452 V5453 V5454 V5455 V5456 V5457))) - -(defun series-term-k (V5458 V5459 V5460 V5461 V5462 V5463 V5464) (let W5465 (reduce (se-subst V5459 V5460 V5463)) (if (se-numeric? W5465) (series-term-coeff V5458 V5459 V5460 V5461 V5462 V5463 V5464 W5465) (cons none ())))) - -(defun series-term-coeff (V5466 V5467 V5468 V5469 V5470 V5471 V5472 V5473) (let W5474 (se-factorial V5469) (if (= W5474 (cons none ())) (cons none ()) (series-term-emit V5466 V5467 V5468 V5469 V5470 V5471 V5472 (num-div V5473 (cons int (cons (hd (tl W5474)) ()))))))) - -(defun series-term-emit (V5475 V5476 V5477 V5478 V5479 V5480 V5481 V5482) (let W5483 (if (num-eq? V5482 (cons int (cons 0 ()))) (cons skip ()) (series-term-expr V5482 V5476 V5477 V5478)) (let W5484 (if (= W5483 (cons skip ())) V5481 (cons W5483 V5481)) (let W5485 (reduce (cons (se-d) (cons V5480 (cons V5476 ())))) (series-terms V5475 V5476 V5477 (+ V5478 1) V5479 W5485 W5484))))) - -(defun series-term-expr (V5486 V5487 V5488 V5489) (cond ((= 0 V5489) V5486) (true (reduce (cons (se-times) (cons V5486 (cons (cons (se-power) (cons (series-basis V5487 V5488) (cons (cons int (cons V5489 ())) ()))) ()))))))) - -(defun series-basis (V5490 V5491) (if (num-eq-zero? V5491) V5490 (cons (se-plus) (cons V5490 (cons (cons (se-times) (cons (cons int (cons -1 ())) (cons V5491 ()))) ()))))) - -(defun num-eq-zero? (V5492) (if (numeric? V5492) (num-eq? V5492 (cons int (cons 0 ()))) false)) - -(defun series-sum (V5493) (cond ((= () V5493) (cons int (cons 0 ()))) ((and (cons? V5493) (= () (tl V5493))) (reduce (hd V5493))) (true (reduce (cons (se-plus) V5493))))) - -(defun se-limit-max-depth () 5) - -(defun limit-builtin (V5494) (trap-error (limit-attempt V5494) (lambda Z5495 (cons none ())))) - -(defun limit-attempt (V5498) (cond ((and (cons? V5498) (and (cons? (tl V5498)) (and (cons? (hd (tl V5498))) (and (= sym (hd (hd (tl V5498)))) (and (cons? (tl (hd (tl V5498)))) (and (= () (tl (tl (hd (tl V5498))))) (and (cons? (tl (tl V5498))) (= () (tl (tl (tl V5498))))))))))) (if (se-infinity? (hd (tl (tl V5498)))) (limit-at-infinity (hd V5498) (hd (tl V5498))) (limit-go (hd V5498) (hd (tl V5498)) (hd (tl (tl V5498))) (se-limit-max-depth)))) (true (cons none ())))) - -(defun se-infinity? (V5501) (cond ((and (cons? V5501) (and (= sym (hd V5501)) (and (cons? (tl V5501)) (= () (tl (tl V5501)))))) (= (str (hd (tl V5501))) "Infinity")) (true false))) - -(defun se-recip (V5502) (cons (cons sym (cons Divide ())) (cons (cons int (cons 1 ())) (cons V5502 ())))) - -(defun limit-at-infinity (V5503 V5504) (lim-inf-ratio V5504 (se-as-ratio V5503))) - -(defun lim-inf-ratio (V5507 V5508) (cond ((and (cons? V5508) (and (= some (hd V5508)) (and (cons? (tl V5508)) (and (cons? (hd (tl V5508))) (and (cons? (tl (hd (tl V5508)))) (and (= () (tl (tl (hd (tl V5508))))) (= () (tl (tl V5508))))))))) (lim-inf-coeffs (expr->coeffs V5507 (hd (hd (tl V5508)))) (expr->coeffs V5507 (hd (tl (hd (tl V5508))))))) (true (cons none ())))) - -(defun lim-inf-coeffs (V5513 V5514) (cond ((and (cons? V5513) (and (= some (hd V5513)) (and (cons? (tl V5513)) (and (= () (tl (tl V5513))) (and (cons? V5514) (and (= some (hd V5514)) (and (cons? (tl V5514)) (= () (tl (tl V5514)))))))))) (lim-inf-decide (coeffs-deg (hd (tl V5513))) (coeffs-deg (hd (tl V5514))) (hd (tl V5513)) (hd (tl V5514)))) (true (cons none ())))) - -(defun lim-inf-decide (V5515 V5516 V5517 V5518) (if (< V5515 V5516) (cons some (cons (cons int (cons 0 ())) ())) (if (= V5515 V5516) (cons some (cons (reduce (cons (se-times) (cons (coeffs-lead V5517) (cons (cons (se-power) (cons (coeffs-lead V5518) (cons (cons int (cons -1 ())) ()))) ())))) ())) (cons none ())))) - -(defun limit-go (V5519 V5520 V5521 V5522) (let W5523 (se-try-subst V5519 V5520 V5521) (if (= W5523 (cons none ())) (limit-lhopital V5519 V5520 V5521 V5522) W5523))) - -(defun se-try-subst (V5524 V5525 V5526) (trap-error (se-subst-numeric V5524 V5525 V5526) (lambda Z5527 (cons none ())))) - -(defun se-subst-numeric (V5528 V5529 V5530) (let W5531 (reduce (se-subst V5529 V5530 V5528)) (if (se-numeric? W5531) (cons some (cons W5531 ())) (cons none ())))) - -(defun limit-lhopital (V5532 V5533 V5534 V5535) (cond ((= 0 V5535) (cons none ())) (true (limit-on-ratio (se-as-ratio V5532) V5533 V5534 V5535)))) - -(defun se-as-ratio (V5538) (cond ((and (cons? V5538) (and (cons? (tl V5538)) (and (cons? (tl (tl V5538))) (= () (tl (tl (tl V5538))))))) (if (se-divide-head? (hd V5538)) (cons some (cons (tl V5538) ())) (cons none ()))) (true (cons none ())))) - -(defun limit-on-ratio (V5545 V5546 V5547 V5548) (cond ((and (cons? V5545) (and (= none (hd V5545)) (= () (tl V5545)))) V5545) ((and (cons? V5545) (and (= some (hd V5545)) (and (cons? (tl V5545)) (and (cons? (hd (tl V5545))) (and (cons? (tl (hd (tl V5545)))) (and (= () (tl (tl (hd (tl V5545))))) (= () (tl (tl V5545))))))))) (limit-check-00 (hd (hd (tl V5545))) (hd (tl (hd (tl V5545)))) V5546 V5547 V5548)) (true (simple-error "partial function limit-on-ratio")))) - -(defun limit-check-00 (V5549 V5550 V5551 V5552 V5553) (let W5554 (reduce (se-subst V5551 V5552 V5549)) (let W5555 (reduce (se-subst V5551 V5552 V5550)) (if (se-both-zero? W5554 W5555) (limit-go (se-make-ratio (reduce (cons (se-d) (cons V5549 (cons V5551 ())))) (reduce (cons (se-d) (cons V5550 (cons V5551 ()))))) V5551 V5552 (- V5553 1)) (cons none ()))))) - -(defun se-both-zero? (V5556 V5557) (if (num-eq-zero? V5556) (if (num-eq-zero? V5557) true false) false)) - -(defun se-make-ratio (V5558 V5559) (cons (cons sym (cons Divide ())) (cons V5558 (cons V5559 ())))) - -(pr "series.shen loaded (Wave E: Series + Limit; sound, inert when unjustified). -" (stoutput)) - -(defun boot-declare-structural (V5560 V5561) (if (sig-present? V5560) true (declare-structural V5560 V5561))) - -(boot-declare-structural (protect Plus) (cons (protect flat) (cons (protect orderless) ()))) - -(boot-declare-structural (protect Times) (cons (protect flat) (cons (protect orderless) ()))) - -(boot-declare-structural (protect Power) ()) - -(register-rule (rule (cons (cons sym (cons (protect Plus) ())) (cons (named (protect x) (blank)) (cons (cons int (cons 0 ())) ()))) (cons sym (cons (protect x) ())))) - -(register-rule (rule (cons (cons sym (cons (protect Times) ())) (cons (named (protect x) (blank)) (cons (cons int (cons 1 ())) ()))) (cons sym (cons (protect x) ())))) - -(register-rule (rule (cons (cons sym (cons (protect Times) ())) (cons (named (protect x) (blank)) (cons (cons int (cons 0 ())) ()))) (cons int (cons 0 ())))) - -(register-rule (rule (cons (cons sym (cons (protect Minus) ())) (cons (named (protect x) (blank)) (cons (cons int (cons 0 ())) ()))) (cons sym (cons (protect x) ())))) - -(boot-declare-structural (protect If) ()) - -(register-rule (rule (cons (cons sym (cons (protect If) ())) (cons (cons sym (cons (protect True) ())) (cons (named (protect then) (blank)) (cons (named (protect else) (blank)) ())))) (cons sym (cons (protect then) ())))) - -(register-rule (rule (cons (cons sym (cons (protect If) ())) (cons (cons sym (cons (protect False) ())) (cons (named (protect then) (blank)) (cons (named (protect else) (blank)) ())))) (cons sym (cons (protect else) ())))) - -(pr "boot/arith.shen loaded. -" (stoutput)) - -(register-rule (rule (cons (cons sym (cons (protect Times) ())) (cons (cons named (cons (protect s) (cons (cons blank-null-seq ()) ()))) (cons (cons int (cons 0 ())) (cons (cons named (cons (protect t) (cons (cons blank-null-seq ()) ()))) ())))) (cons int (cons 0 ())))) - -(register-rule (rule (cons (cons sym (cons (protect Times) ())) (cons (cons named (cons (protect s) (cons (cons blank-null-seq ()) ()))) (cons (cons int (cons 1 ())) (cons (cons named (cons (protect t) (cons (cons blank-null-seq ()) ()))) ())))) (cons (cons sym (cons (protect Times) ())) (cons (cons sym (cons (protect s) ())) (cons (cons sym (cons (protect t) ())) ()))))) - -(register-rule (rule (cons condition (cons (cons (cons sym (cons (protect Power) ())) (cons (cons int (cons 0 ())) (cons (cons named (cons (protect n) (cons (cons blank ()) ()))) ()))) (cons (cons (cons sym (cons (protect Positive) ())) (cons (cons sym (cons (protect n) ())) ())) ()))) (cons int (cons 0 ())))) - -(register-rule (rule (cons (cons sym (cons (protect Power) ())) (cons (cons named (cons (protect x) (cons (cons blank ()) ()))) (cons (cons int (cons 1 ())) ()))) (cons sym (cons (protect x) ())))) - -(register-rule (rule (cons condition (cons (cons (cons sym (cons (protect Power) ())) (cons (cons named (cons (protect x) (cons (cons blank ()) ()))) (cons (cons int (cons 0 ())) ()))) (cons (cons (cons sym (cons (protect UnsameQ) ())) (cons (cons sym (cons (protect x) ())) (cons (cons int (cons 0 ())) ()))) ()))) (cons int (cons 1 ())))) - -(register-rule (rule (cons (cons sym (cons (protect Plus) ())) (cons (cons named (cons (protect x) (cons (cons blank ()) ()))) ())) (cons sym (cons (protect x) ())))) - -(register-rule (rule (cons (cons sym (cons (protect Times) ())) (cons (cons named (cons (protect x) (cons (cons blank ()) ()))) ())) (cons sym (cons (protect x) ())))) - -(pr "boot/simplify.shen loaded. -" (stoutput)) - -(defun boot-declare-elem (V5562) (if (sig-present? V5562) true (declare-structural V5562 ()))) - -(boot-declare-elem (protect Sin)) - -(boot-declare-elem (protect Cos)) - -(boot-declare-elem (protect Tan)) - -(boot-declare-elem (protect Sec)) - -(boot-declare-elem (protect Exp)) - -(boot-declare-elem (protect Log)) - -(boot-declare-elem (protect Sqrt)) - -(boot-declare-elem (protect ArcSin)) - -(boot-declare-elem (protect ArcCos)) - -(boot-declare-elem (protect ArcTan)) - -(boot-declare-elem (protect D)) - -(boot-declare-elem (protect Integrate)) - -(register-rule (rule (cons (cons sym (cons (protect Sin) ())) (cons (cons int (cons 0 ())) ())) (cons int (cons 0 ())))) - -(register-rule (rule (cons (cons sym (cons (protect Cos) ())) (cons (cons int (cons 0 ())) ())) (cons int (cons 1 ())))) - -(register-rule (rule (cons (cons sym (cons (protect Exp) ())) (cons (cons int (cons 0 ())) ())) (cons int (cons 1 ())))) - -(register-rule (rule (cons (cons sym (cons (protect Log) ())) (cons (cons int (cons 1 ())) ())) (cons int (cons 0 ())))) - -(register-rule (rule (cons (cons sym (cons (protect Sqrt) ())) (cons (cons int (cons 0 ())) ())) (cons int (cons 0 ())))) - -(register-rule (rule (cons (cons sym (cons (protect Sqrt) ())) (cons (cons int (cons 1 ())) ())) (cons int (cons 1 ())))) - -(register-rule (rule (cons (cons sym (cons (protect Sqrt) ())) (cons (cons named (cons (protect u) (cons (cons blank ()) ()))) ())) (cons (cons sym (cons (protect Power) ())) (cons (cons sym (cons (protect u) ())) (cons (cons rat (cons 1 (cons 2 ()))) ()))))) - -(register-rule (rule (cons (cons sym (cons (protect Power) ())) (cons (cons (cons sym (cons (protect Power) ())) (cons (cons named (cons (protect u) (cons (cons blank ()) ()))) (cons (cons rat (cons 1 (cons 2 ()))) ()))) (cons (cons int (cons 2 ())) ()))) (cons sym (cons (protect u) ())))) - -(pr "boot/elemfun.shen loaded (elementary symbols + exact-value table). -" (stoutput)) - -(register-rule (rule (cons condition (cons (cons (cons sym (cons (protect D) ())) (cons (cons named (cons (protect a) (cons (cons blank ()) ()))) (cons (cons named (cons (protect x) (cons (cons blank ()) ()))) ()))) (cons (cons (cons sym (cons (protect SameQ) ())) (cons (cons sym (cons (protect a) ())) (cons (cons sym (cons (protect x) ())) ()))) ()))) (cons int (cons 1 ())))) - -(register-rule (rule (cons condition (cons (cons (cons sym (cons (protect D) ())) (cons (cons named (cons (protect a) (cons (cons blank ()) ()))) (cons (cons named (cons (protect x) (cons (cons blank ()) ()))) ()))) (cons (cons (cons sym (cons (protect FreeQ) ())) (cons (cons sym (cons (protect a) ())) (cons (cons sym (cons (protect x) ())) ()))) ()))) (cons int (cons 0 ())))) - -(register-rule (rule (cons (cons sym (cons (protect D) ())) (cons (cons (cons sym (cons (protect Plus) ())) (cons (cons named (cons (protect a) (cons (cons blank ()) ()))) (cons (cons named (cons (protect r) (cons (cons blank-seq ()) ()))) ()))) (cons (cons named (cons (protect x) (cons (cons blank ()) ()))) ()))) (cons (cons sym (cons (protect Plus) ())) (cons (cons (cons sym (cons (protect D) ())) (cons (cons sym (cons (protect a) ())) (cons (cons sym (cons (protect x) ())) ()))) (cons (cons (cons sym (cons (protect D) ())) (cons (cons (cons sym (cons (protect Plus) ())) (cons (cons sym (cons (protect r) ())) ())) (cons (cons sym (cons (protect x) ())) ()))) ()))))) - -(register-rule (rule (cons condition (cons (cons (cons sym (cons (protect D) ())) (cons (cons (cons sym (cons (protect Power) ())) (cons (cons named (cons (protect u) (cons (cons blank ()) ()))) (cons (cons named (cons (protect n) (cons (cons blank ()) ()))) ()))) (cons (cons named (cons (protect x) (cons (cons blank ()) ()))) ()))) (cons (cons (cons sym (cons (protect FreeQ) ())) (cons (cons sym (cons (protect n) ())) (cons (cons sym (cons (protect x) ())) ()))) ()))) (cons (cons sym (cons (protect Times) ())) (cons (cons sym (cons (protect n) ())) (cons (cons (cons sym (cons (protect Power) ())) (cons (cons sym (cons (protect u) ())) (cons (cons (cons sym (cons (protect Plus) ())) (cons (cons sym (cons (protect n) ())) (cons (cons int (cons -1 ())) ()))) ()))) (cons (cons (cons sym (cons (protect D) ())) (cons (cons sym (cons (protect u) ())) (cons (cons sym (cons (protect x) ())) ()))) ())))))) - -(register-rule (rule (cons (cons sym (cons (protect D) ())) (cons (cons (cons sym (cons (protect Power) ())) (cons (cons named (cons (protect u) (cons (cons blank ()) ()))) (cons (cons named (cons (protect v) (cons (cons blank ()) ()))) ()))) (cons (cons named (cons (protect x) (cons (cons blank ()) ()))) ()))) (cons (cons sym (cons (protect Times) ())) (cons (cons (cons sym (cons (protect Power) ())) (cons (cons sym (cons (protect u) ())) (cons (cons sym (cons (protect v) ())) ()))) (cons (cons (cons sym (cons (protect D) ())) (cons (cons (cons sym (cons (protect Times) ())) (cons (cons sym (cons (protect v) ())) (cons (cons (cons sym (cons (protect Log) ())) (cons (cons sym (cons (protect u) ())) ())) ()))) (cons (cons sym (cons (protect x) ())) ()))) ()))))) - -(register-rule (rule (cons (cons sym (cons (protect D) ())) (cons (cons (cons sym (cons (protect Times) ())) (cons (cons named (cons (protect a) (cons (cons blank ()) ()))) (cons (cons named (cons (protect r) (cons (cons blank-seq ()) ()))) ()))) (cons (cons named (cons (protect x) (cons (cons blank ()) ()))) ()))) (cons (cons sym (cons (protect Plus) ())) (cons (cons (cons sym (cons (protect Times) ())) (cons (cons (cons sym (cons (protect D) ())) (cons (cons sym (cons (protect a) ())) (cons (cons sym (cons (protect x) ())) ()))) (cons (cons (cons sym (cons (protect Times) ())) (cons (cons sym (cons (protect r) ())) ())) ()))) (cons (cons (cons sym (cons (protect Times) ())) (cons (cons sym (cons (protect a) ())) (cons (cons (cons sym (cons (protect D) ())) (cons (cons (cons sym (cons (protect Times) ())) (cons (cons sym (cons (protect r) ())) ())) (cons (cons sym (cons (protect x) ())) ()))) ()))) ()))))) - -(register-rule (rule (cons (cons sym (cons (protect D) ())) (cons (cons (cons sym (cons (protect Divide) ())) (cons (cons named (cons (protect a) (cons (cons blank ()) ()))) (cons (cons named (cons (protect b) (cons (cons blank ()) ()))) ()))) (cons (cons named (cons (protect x) (cons (cons blank ()) ()))) ()))) (cons (cons sym (cons (protect D) ())) (cons (cons (cons sym (cons (protect Times) ())) (cons (cons sym (cons (protect a) ())) (cons (cons (cons sym (cons (protect Power) ())) (cons (cons sym (cons (protect b) ())) (cons (cons int (cons -1 ())) ()))) ()))) (cons (cons sym (cons (protect x) ())) ()))))) - -(register-rule (rule (cons (cons sym (cons (protect D) ())) (cons (cons (cons sym (cons (protect Sin) ())) (cons (cons named (cons (protect u) (cons (cons blank ()) ()))) ())) (cons (cons named (cons (protect x) (cons (cons blank ()) ()))) ()))) (cons (cons sym (cons (protect Times) ())) (cons (cons (cons sym (cons (protect Cos) ())) (cons (cons sym (cons (protect u) ())) ())) (cons (cons (cons sym (cons (protect D) ())) (cons (cons sym (cons (protect u) ())) (cons (cons sym (cons (protect x) ())) ()))) ()))))) - -(register-rule (rule (cons (cons sym (cons (protect D) ())) (cons (cons (cons sym (cons (protect Cos) ())) (cons (cons named (cons (protect u) (cons (cons blank ()) ()))) ())) (cons (cons named (cons (protect x) (cons (cons blank ()) ()))) ()))) (cons (cons sym (cons (protect Times) ())) (cons (cons int (cons -1 ())) (cons (cons (cons sym (cons (protect Sin) ())) (cons (cons sym (cons (protect u) ())) ())) (cons (cons (cons sym (cons (protect D) ())) (cons (cons sym (cons (protect u) ())) (cons (cons sym (cons (protect x) ())) ()))) ())))))) - -(register-rule (rule (cons (cons sym (cons (protect D) ())) (cons (cons (cons sym (cons (protect Exp) ())) (cons (cons named (cons (protect u) (cons (cons blank ()) ()))) ())) (cons (cons named (cons (protect x) (cons (cons blank ()) ()))) ()))) (cons (cons sym (cons (protect Times) ())) (cons (cons (cons sym (cons (protect Exp) ())) (cons (cons sym (cons (protect u) ())) ())) (cons (cons (cons sym (cons (protect D) ())) (cons (cons sym (cons (protect u) ())) (cons (cons sym (cons (protect x) ())) ()))) ()))))) - -(register-rule (rule (cons (cons sym (cons (protect D) ())) (cons (cons (cons sym (cons (protect Log) ())) (cons (cons named (cons (protect u) (cons (cons blank ()) ()))) ())) (cons (cons named (cons (protect x) (cons (cons blank ()) ()))) ()))) (cons (cons sym (cons (protect Times) ())) (cons (cons (cons sym (cons (protect Power) ())) (cons (cons sym (cons (protect u) ())) (cons (cons int (cons -1 ())) ()))) (cons (cons (cons sym (cons (protect D) ())) (cons (cons sym (cons (protect u) ())) (cons (cons sym (cons (protect x) ())) ()))) ()))))) - -(register-rule (rule (cons (cons sym (cons (protect D) ())) (cons (cons (cons sym (cons (protect Tan) ())) (cons (cons named (cons (protect u) (cons (cons blank ()) ()))) ())) (cons (cons named (cons (protect x) (cons (cons blank ()) ()))) ()))) (cons (cons sym (cons (protect Times) ())) (cons (cons (cons sym (cons (protect Power) ())) (cons (cons (cons sym (cons (protect Sec) ())) (cons (cons sym (cons (protect u) ())) ())) (cons (cons int (cons 2 ())) ()))) (cons (cons (cons sym (cons (protect D) ())) (cons (cons sym (cons (protect u) ())) (cons (cons sym (cons (protect x) ())) ()))) ()))))) - -(register-rule (rule (cons (cons sym (cons (protect D) ())) (cons (cons (cons sym (cons (protect Sqrt) ())) (cons (cons named (cons (protect u) (cons (cons blank ()) ()))) ())) (cons (cons named (cons (protect x) (cons (cons blank ()) ()))) ()))) (cons (cons sym (cons (protect D) ())) (cons (cons (cons sym (cons (protect Power) ())) (cons (cons sym (cons (protect u) ())) (cons (cons rat (cons 1 (cons 2 ()))) ()))) (cons (cons sym (cons (protect x) ())) ()))))) - -(register-rule (rule (cons (cons sym (cons (protect D) ())) (cons (cons (cons sym (cons (protect ArcTan) ())) (cons (cons named (cons (protect u) (cons (cons blank ()) ()))) ())) (cons (cons named (cons (protect x) (cons (cons blank ()) ()))) ()))) (cons (cons sym (cons (protect Times) ())) (cons (cons (cons sym (cons (protect Power) ())) (cons (cons (cons sym (cons (protect Plus) ())) (cons (cons int (cons 1 ())) (cons (cons (cons sym (cons (protect Power) ())) (cons (cons sym (cons (protect u) ())) (cons (cons int (cons 2 ())) ()))) ()))) (cons (cons int (cons -1 ())) ()))) (cons (cons (cons sym (cons (protect D) ())) (cons (cons sym (cons (protect u) ())) (cons (cons sym (cons (protect x) ())) ()))) ()))))) - -(register-rule (rule (cons (cons sym (cons (protect D) ())) (cons (cons (cons sym (cons (protect ArcSin) ())) (cons (cons named (cons (protect u) (cons (cons blank ()) ()))) ())) (cons (cons named (cons (protect x) (cons (cons blank ()) ()))) ()))) (cons (cons sym (cons (protect Times) ())) (cons (cons (cons sym (cons (protect Power) ())) (cons (cons (cons sym (cons (protect Plus) ())) (cons (cons int (cons 1 ())) (cons (cons (cons sym (cons (protect Times) ())) (cons (cons int (cons -1 ())) (cons (cons (cons sym (cons (protect Power) ())) (cons (cons sym (cons (protect u) ())) (cons (cons int (cons 2 ())) ()))) ()))) ()))) (cons (cons rat (cons -1 (cons 2 ()))) ()))) (cons (cons (cons sym (cons (protect D) ())) (cons (cons sym (cons (protect u) ())) (cons (cons sym (cons (protect x) ())) ()))) ()))))) - -(register-rule (rule (cons (cons sym (cons (protect D) ())) (cons (cons (cons sym (cons (protect ArcCos) ())) (cons (cons named (cons (protect u) (cons (cons blank ()) ()))) ())) (cons (cons named (cons (protect x) (cons (cons blank ()) ()))) ()))) (cons (cons sym (cons (protect Times) ())) (cons (cons int (cons -1 ())) (cons (cons (cons sym (cons (protect Power) ())) (cons (cons (cons sym (cons (protect Plus) ())) (cons (cons int (cons 1 ())) (cons (cons (cons sym (cons (protect Times) ())) (cons (cons int (cons -1 ())) (cons (cons (cons sym (cons (protect Power) ())) (cons (cons sym (cons (protect u) ())) (cons (cons int (cons 2 ())) ()))) ()))) ()))) (cons (cons rat (cons -1 (cons 2 ()))) ()))) (cons (cons (cons sym (cons (protect D) ())) (cons (cons sym (cons (protect u) ())) (cons (cons sym (cons (protect x) ())) ()))) ())))))) - -(register-rule (rule (cons (cons sym (cons (protect D) ())) (cons (cons (cons sym (cons (protect Sec) ())) (cons (cons named (cons (protect u) (cons (cons blank ()) ()))) ())) (cons (cons named (cons (protect x) (cons (cons blank ()) ()))) ()))) (cons (cons sym (cons (protect Times) ())) (cons (cons (cons sym (cons (protect Sec) ())) (cons (cons sym (cons (protect u) ())) ())) (cons (cons (cons sym (cons (protect Tan) ())) (cons (cons sym (cons (protect u) ())) ())) (cons (cons (cons sym (cons (protect D) ())) (cons (cons sym (cons (protect u) ())) (cons (cons sym (cons (protect x) ())) ()))) ())))))) - -(if (= (make-rat 6 4) (cons rat (cons 3 (cons 2 ())))) (pr "SCUD 21: rational tower verified (make-rat 6 4 = [rat 3 2]). -" (stoutput)) (simple-error "SCUD 21 integration requires the rational tower (make-rat) -- not wired")) - -(register-rule (rule (cons condition (cons (cons (cons sym (cons (protect Integrate) ())) (cons (cons (cons sym (cons (protect Power) ())) (cons (cons named (cons (protect u) (cons (cons blank ()) ()))) (cons (cons int (cons -1 ())) ()))) (cons (cons named (cons (protect x) (cons (cons blank ()) ()))) ()))) (cons (cons (cons sym (cons (protect SameQ) ())) (cons (cons sym (cons (protect u) ())) (cons (cons sym (cons (protect x) ())) ()))) ()))) (cons (cons sym (cons (protect Log) ())) (cons (cons sym (cons (protect x) ())) ())))) - -(register-rule (rule (cons condition (cons (cons (cons sym (cons (protect Integrate) ())) (cons (cons (cons sym (cons (protect Sin) ())) (cons (cons named (cons (protect u) (cons (cons blank ()) ()))) ())) (cons (cons named (cons (protect x) (cons (cons blank ()) ()))) ()))) (cons (cons (cons sym (cons (protect SameQ) ())) (cons (cons sym (cons (protect u) ())) (cons (cons sym (cons (protect x) ())) ()))) ()))) (cons (cons sym (cons (protect Times) ())) (cons (cons int (cons -1 ())) (cons (cons (cons sym (cons (protect Cos) ())) (cons (cons sym (cons (protect x) ())) ())) ()))))) - -(register-rule (rule (cons condition (cons (cons (cons sym (cons (protect Integrate) ())) (cons (cons (cons sym (cons (protect Cos) ())) (cons (cons named (cons (protect u) (cons (cons blank ()) ()))) ())) (cons (cons named (cons (protect x) (cons (cons blank ()) ()))) ()))) (cons (cons (cons sym (cons (protect SameQ) ())) (cons (cons sym (cons (protect u) ())) (cons (cons sym (cons (protect x) ())) ()))) ()))) (cons (cons sym (cons (protect Sin) ())) (cons (cons sym (cons (protect x) ())) ())))) - -(register-rule (rule (cons condition (cons (cons (cons sym (cons (protect Integrate) ())) (cons (cons (cons sym (cons (protect Exp) ())) (cons (cons named (cons (protect u) (cons (cons blank ()) ()))) ())) (cons (cons named (cons (protect x) (cons (cons blank ()) ()))) ()))) (cons (cons (cons sym (cons (protect SameQ) ())) (cons (cons sym (cons (protect u) ())) (cons (cons sym (cons (protect x) ())) ()))) ()))) (cons (cons sym (cons (protect Exp) ())) (cons (cons sym (cons (protect x) ())) ())))) - -(register-rule (rule (cons condition (cons (cons (cons sym (cons (protect Integrate) ())) (cons (cons (cons sym (cons (protect Power) ())) (cons (cons named (cons (protect u) (cons (cons blank ()) ()))) (cons (cons named (cons (protect n) (cons (cons blank ()) ()))) ()))) (cons (cons named (cons (protect x) (cons (cons blank ()) ()))) ()))) (cons (cons (cons sym (cons (protect And) ())) (cons (cons (cons sym (cons (protect SameQ) ())) (cons (cons sym (cons (protect u) ())) (cons (cons sym (cons (protect x) ())) ()))) (cons (cons (cons sym (cons (protect And) ())) (cons (cons (cons sym (cons (protect FreeQ) ())) (cons (cons sym (cons (protect n) ())) (cons (cons sym (cons (protect x) ())) ()))) (cons (cons (cons sym (cons (protect UnsameQ) ())) (cons (cons sym (cons (protect n) ())) (cons (cons int (cons -1 ())) ()))) ()))) ()))) ()))) (cons (cons sym (cons (protect Times) ())) (cons (cons (cons sym (cons (protect Power) ())) (cons (cons sym (cons (protect x) ())) (cons (cons (cons sym (cons (protect Plus) ())) (cons (cons sym (cons (protect n) ())) (cons (cons int (cons 1 ())) ()))) ()))) (cons (cons (cons sym (cons (protect Power) ())) (cons (cons (cons sym (cons (protect Plus) ())) (cons (cons sym (cons (protect n) ())) (cons (cons int (cons 1 ())) ()))) (cons (cons int (cons -1 ())) ()))) ()))))) - -(register-rule (rule (cons condition (cons (cons (cons sym (cons (protect Integrate) ())) (cons (cons named (cons (protect u) (cons (cons blank ()) ()))) (cons (cons named (cons (protect x) (cons (cons blank ()) ()))) ()))) (cons (cons (cons sym (cons (protect SameQ) ())) (cons (cons sym (cons (protect u) ())) (cons (cons sym (cons (protect x) ())) ()))) ()))) (cons (cons sym (cons (protect Times) ())) (cons (cons (cons sym (cons (protect Power) ())) (cons (cons sym (cons (protect x) ())) (cons (cons int (cons 2 ())) ()))) (cons (cons rat (cons 1 (cons 2 ()))) ()))))) - -(register-rule (rule (cons (cons sym (cons (protect Integrate) ())) (cons (cons (cons sym (cons (protect Plus) ())) (cons (cons named (cons (protect a) (cons (cons blank ()) ()))) (cons (cons named (cons (protect r) (cons (cons blank-seq ()) ()))) ()))) (cons (cons named (cons (protect x) (cons (cons blank ()) ()))) ()))) (cons (cons sym (cons (protect Plus) ())) (cons (cons (cons sym (cons (protect Integrate) ())) (cons (cons sym (cons (protect a) ())) (cons (cons sym (cons (protect x) ())) ()))) (cons (cons (cons sym (cons (protect Integrate) ())) (cons (cons (cons sym (cons (protect Plus) ())) (cons (cons sym (cons (protect r) ())) ())) (cons (cons sym (cons (protect x) ())) ()))) ()))))) - -(register-rule (rule (cons condition (cons (cons (cons sym (cons (protect Integrate) ())) (cons (cons (cons sym (cons (protect Times) ())) (cons (cons named (cons (protect c) (cons (cons blank ()) ()))) (cons (cons named (cons (protect f) (cons (cons blank-seq ()) ()))) ()))) (cons (cons named (cons (protect x) (cons (cons blank ()) ()))) ()))) (cons (cons (cons sym (cons (protect FreeQ) ())) (cons (cons sym (cons (protect c) ())) (cons (cons sym (cons (protect x) ())) ()))) ()))) (cons (cons sym (cons (protect Times) ())) (cons (cons sym (cons (protect c) ())) (cons (cons (cons sym (cons (protect Integrate) ())) (cons (cons (cons sym (cons (protect Times) ())) (cons (cons sym (cons (protect f) ())) ())) (cons (cons sym (cons (protect x) ())) ()))) ()))))) - -(register-rule (rule (cons condition (cons (cons (cons sym (cons (protect Integrate) ())) (cons (cons named (cons (protect c) (cons (cons blank ()) ()))) (cons (cons named (cons (protect x) (cons (cons blank ()) ()))) ()))) (cons (cons (cons sym (cons (protect FreeQ) ())) (cons (cons sym (cons (protect c) ())) (cons (cons sym (cons (protect x) ())) ()))) ()))) (cons (cons sym (cons (protect Times) ())) (cons (cons sym (cons (protect c) ())) (cons (cons sym (cons (protect x) ())) ()))))) - -(pr "boot/calculus.shen loaded (D + bounded Integrate rule library). -" (stoutput)) - -(defun reduce-ref (V5563) (reduce-db (value *db*) V5563)) - -(defun normal-form-ref (V5564) (normal-form-db (value *db*) V5564)) - -(defun reduce-compiled (V5565) V5565) - -(defun normal-form-compiled (V5566) V5566) - -(set *current-core* ref) - -(defun current-core () (value *current-core*)) - -(defun set-current-core (V5567) (set *current-core* V5567)) - -(defun reduce-via (V5570 V5571) (cond ((= ref V5570) (reduce-ref V5571)) ((= compiled V5570) (reduce-compiled V5571)) (true (reduce-ref V5571)))) - -(defun normal-form-via (V5574 V5575) (cond ((= ref V5574) (normal-form-ref V5575)) ((= compiled V5574) (normal-form-compiled V5575)) (true (normal-form-ref V5575)))) - -(set *max-eval-steps* 1000) - -(set *listable-on* false) - -(defun rules-for-expr (V5576 V5577) (if (and (cons? V5576) (not (empty? (db-datoms V5576)))) (dispatch-candidates V5576 V5577) ())) - -(defun reduce-args (V5578 V5579) (if (expr-compound? V5579) (reduce-args-compound V5578 V5579) V5579)) - -(defun reduce-args-compound (V5580 V5581) (cond ((cons? V5581) (if (sym? (hd V5581)) (let W5582 (sym-name (hd V5581)) (if (holds-all? V5580 W5582) V5581 (if (holds-first? V5580 W5582) (cons (hd V5581) (cons (hd (tl V5581)) (map (lambda Z5583 (reduce-db V5580 Z5583)) (tl (tl V5581))))) (if (holds-rest? V5580 W5582) (cons (hd V5581) (cons (reduce-db V5580 (hd (tl V5581))) (tl (tl V5581)))) (cons (hd V5581) (map (lambda Z5584 (reduce-db V5580 Z5584)) (tl V5581))))))) (cons (hd V5581) (map (lambda Z5585 (reduce-db V5580 Z5585)) (tl V5581))))) (true (simple-error "partial function reduce-args-compound")))) - -(defun canon-flat-orderless (V5586 V5587) (cond ((cons? V5587) (if (sym? (hd V5587)) (let W5588 (sym-name (hd V5587)) (let W5589 (if (has-flat? W5588) (flatten-flat-args (hd V5587) (tl V5587)) (tl V5587)) (let W5590 (if (has-orderless? W5588) (sort-exprs-by-hash W5589) W5589) (cons (hd V5587) W5590)))) V5587)) (true V5587))) - -(defun sort-exprs-by-hash (V5591) (sort-exprs-insert V5591)) - -(defun sort-exprs-insert (V5592) (cond ((= () V5592) ()) ((cons? V5592) (insert-expr-by-hash (hd V5592) (sort-exprs-insert (tl V5592)))) (true (simple-error "partial function sort-exprs-insert")))) - -(defun insert-expr-by-hash (V5593 V5594) (cond ((= () V5594) (cons V5593 ())) ((cons? V5594) (if (<= (unwrap-ch (content-hash V5593)) (unwrap-ch (content-hash (hd V5594)))) (cons V5593 V5594) (cons (hd V5594) (insert-expr-by-hash V5593 (tl V5594))))) (true (simple-error "partial function insert-expr-by-hash")))) - -(defun try-builtin (V5595) (cond ((cons? V5595) (if (sym? (hd V5595)) (apply-builtin-result (builtin-result (hd V5595) (tl V5595)) V5595) V5595)) (true V5595))) - -(defun builtin-result (V5596 V5597) (let W5598 (num-builtin V5596 V5597) (if (= W5598 (cons none ())) (calc-builtin V5596 V5597) W5598))) - -(defun apply-builtin-result (V5603 V5604) (cond ((and (cons? V5603) (and (= some (hd V5603)) (and (cons? (tl V5603)) (= () (tl (tl V5603)))))) (hd (tl V5603))) ((and (cons? V5603) (and (= none (hd V5603)) (= () (tl V5603)))) V5604) (true V5604))) - -(defun up-candidates (V5609 V5610) (cond ((cons? V5610) (up-candidates-for-args V5609 (tl V5610))) (true ()))) - -(defun up-candidates-for-args (V5611 V5612) (cond ((= () V5612) ()) ((cons? V5612) (append (up-candidates-for-arg V5611 (hd V5612)) (up-candidates-for-args V5611 (tl V5612)))) (true (simple-error "partial function up-candidates-for-args")))) - -(defun up-candidates-for-arg (V5617 V5618) (cond ((cons? V5618) (if (sym? (hd V5618)) (up-rules V5617 (sym-name (hd V5618))) ())) (true ()))) - -(defun up-rules (V5619 V5620) (let W5621 (symbol-entry-view V5619 (cons sym (cons V5620 ()))) (hd (tl (tl (tl W5621)))))) - -(defun eval-step (V5622 V5623) (if (block-form? V5623) (reduce-block V5622 V5623) (if (expr-compound? V5623) (eval-step-compound V5622 V5623) V5623))) - -(defun eval-step-compound (V5624 V5625) (let W5626 (reduce-args V5624 V5625) (let W5627 (canon-flat-orderless V5624 W5626) (let W5628 (try-builtin W5627) (if (not (content-eq W5628 W5627)) W5628 (let W5629 (rules-for-expr V5624 W5627) (let W5630 (try-reduce-db V5624 W5627 W5629) (if (not (content-eq W5630 W5627)) W5630 (let W5631 (up-candidates V5624 W5627) (try-reduce-db V5624 W5627 W5631)))))))))) - -(defun reduce-db (V5632 V5633) (reduce-fixpoint V5632 V5633 (value *max-eval-steps*))) - -(defun reduce-fixpoint (V5634 V5635 V5636) (cond ((= 0 V5636) (do (pr (cn "WARNING: *max-eval-steps* exceeded; returning " (shen.app (pretty-expr V5635) " -" shen.a)) (stoutput)) V5635)) (true (let W5637 (eval-step V5634 V5635) (if (content-eq W5637 V5635) W5637 (reduce-fixpoint V5634 W5637 (- V5636 1))))))) - -(set *max-rule-tries* 2000) - -(defun try-reduce-db (V5638 V5639 V5640) (try-reduce-db-fuel V5638 V5639 V5640 (value *max-rule-tries*))) - -(defun try-reduce-db-fuel (V5643 V5644 V5645 V5646) (cond ((= () V5645) V5644) ((and (cons? V5645) (= 0 V5646)) (do (pr (cn "WARNING: *max-rule-tries* exceeded at " (shen.app (pretty-expr V5644) "; leaving inert -" shen.a)) (stoutput)) V5644)) ((cons? V5645) (if (checked-rule? (hd V5645)) (let W5647 (rule-lhs (hd V5645)) (let W5648 (rule-rhs (hd V5645)) (let W5649 (match W5647 V5644) (if (match-some? W5649) (substitute (match-unwrap W5649) W5648) (try-reduce-db-fuel V5643 V5644 (tl V5645) (- V5646 1)))))) (try-reduce-db-fuel V5643 V5644 (tl V5645) (- V5646 1)))) (true (simple-error "partial function try-reduce-db-fuel")))) - -(defun rule-lhs (V5652) (cond ((and (cons? V5652) (and (= rule (hd V5652)) (and (cons? (tl V5652)) (and (cons? (tl (tl V5652))) (= () (tl (tl (tl V5652)))))))) (hd (tl V5652))) (true (simple-error "partial function rule-lhs")))) - -(defun rule-rhs (V5655) (cond ((and (cons? V5655) (and (= rule (hd V5655)) (and (cons? (tl V5655)) (and (cons? (tl (tl V5655))) (= () (tl (tl (tl V5655)))))))) (hd (tl (tl V5655)))) (true (simple-error "partial function rule-rhs")))) - -(defun block-form? (V5662) (cond ((and (cons? V5662) (and (cons? (hd V5662)) (and (= sym (hd (hd V5662))) (and (cons? (tl (hd V5662))) (and (= block (hd (tl (hd V5662)))) (and (= () (tl (tl (hd V5662)))) (and (cons? (tl V5662)) (and (cons? (tl (tl V5662))) (= () (tl (tl (tl V5662)))))))))))) true) (true false))) - -(defun reduce-block (V5663 V5664) (cond ((and (cons? V5664) (and (cons? (hd V5664)) (and (= sym (hd (hd V5664))) (and (cons? (tl (hd V5664))) (and (= block (hd (tl (hd V5664)))) (and (= () (tl (tl (hd V5664)))) (and (cons? (tl V5664)) (and (cons? (tl (tl V5664))) (= () (tl (tl (tl V5664)))))))))))) (let W5665 (apply-block-binds V5663 (hd (tl V5664))) (reduce-db W5665 (hd (tl (tl V5664)))))) (true V5664))) - -(defun apply-block-binds (V5668 V5669) (cond ((= () V5669) V5668) ((and (cons? V5669) (and (cons? (hd V5669)) (and (cons? (hd (hd V5669))) (and (= sym (hd (hd (hd V5669)))) (and (cons? (tl (hd (hd V5669)))) (and (= block-bind (hd (tl (hd (hd V5669))))) (and (= () (tl (tl (hd (hd V5669))))) (and (cons? (tl (hd V5669))) (and (cons? (tl (tl (hd V5669)))) (= () (tl (tl (tl (hd V5669)))))))))))))) (let W5670 (cons (hd (tl (hd V5669))) (cons own (cons (make-rule-datum (cons sym (cons (hd (tl (hd V5669))) ())) (hd (tl (tl (hd V5669))))) (cons (db-size V5668) ())))) (let W5671 (db-fork-with V5668 (cons W5670 ())) (apply-block-binds W5671 (tl V5669))))) (true V5668))) - -(defun reduce (V5672) (reduce-via (current-core) V5672)) - -(defun normal-form-db (V5673 V5674) (let W5675 (content-hash V5674) (let W5676 (db-basis V5673) (let W5677 (nf-cache-key W5675 W5676) (let W5678 (nf-lookup W5677) (if (assoc-hit? W5678) (hd (tl W5678)) (let W5679 (reduce-db V5673 V5674) (let W5680 (nf-store! W5677 W5679) W5679)))))))) - -(defun normal-form (V5681) (normal-form-via (current-core) V5681)) - -(defun demo-register-arith () (do (load "boot/arith.shen") true)) - -(defun demo-register-simplify () (do (demo-register-arith) (do (load "boot/simplify.shen") true))) - -(defun demo-register-calculus () (do (demo-register-simplify) (do (load "boot/elemfun.shen") (do (load "boot/calculus.shen") true)))) - -(defun demo-reduce (V5682) (let W5683 (demo-register-arith) (reduce V5682))) - -(pr "core.shen (eval-step fixpoint evaluator + arith hook + seam) loaded. -" (stoutput)) - -(set *gensym-counter* 0) - -(defun cas-gensym (V5684) (let W5685 (value *gensym-counter*) (let W5686 (set *gensym-counter* (+ W5685 1)) (intern (cn (str V5684) (cn "$" (str W5685))))))) - -(defun ensure-bare-symbol (V5687) (cond ((symbol? V5687) V5687) ((and (cons? V5687) (and (= sym (hd V5687)) (and (cons? (tl V5687)) (= () (tl (tl V5687)))))) (hd (tl V5687))) (true (simple-error (cn "scope: binder must be symbol (not " (shen.app V5687 ")" shen.s)))))) - -(defun generate-canon-bare (V5688) (cond ((= 0 V5688) ()) (true (generate-canon-bare-helper 0 V5688)))) - -(defun generate-canon-bare-helper (V5689 V5690) (cond ((>= V5689 V5690) ()) (true (cons (intern (cn "G$" (str V5689))) (generate-canon-bare-helper (+ V5689 1) V5690))))) - -(defun rename-in-expr (V5695 V5696 V5697) (cond ((and (= () V5695) (= () V5696)) V5697) ((and (cons? V5695) (cons? V5696)) (rename-in-expr (tl V5695) (tl V5696) (rename-one (hd V5695) (hd V5696) V5697))) (true V5697))) - -(defun rename-one (V5698 V5699 V5700) (cond ((and (cons? V5700) (and (= sym (hd V5700)) (and (cons? (tl V5700)) (and (= () (tl (tl V5700))) (= (hd (tl V5700)) V5698))))) (cons sym (cons V5699 ()))) ((and (symbol? V5700) (= V5700 V5698)) V5699) ((and (cons? V5700) (and (= int (hd V5700)) (and (cons? (tl V5700)) (= () (tl (tl V5700)))))) V5700) ((cons? V5700) (cons (rename-one V5698 V5699 (hd V5700)) (map (lambda Z5701 (rename-one V5698 V5699 Z5701)) (tl V5700)))) (true V5700))) - -(defun scope-alpha-canonicalize (V5702) (cond ((and (cons? V5702) (and (cons? (hd V5702)) (and (= sym (hd (hd V5702))) (and (cons? (tl (hd V5702))) (and (= module (hd (tl (hd V5702)))) (and (= () (tl (tl (hd V5702)))) (and (cons? (tl V5702)) (and (cons? (tl (tl V5702))) (= () (tl (tl (tl V5702)))))))))))) (let W5703 (map (lambda Z5704 (ensure-bare-symbol Z5704)) (hd (tl V5702))) (let W5705 (generate-canon-bare (length W5703)) (let W5706 (scope-alpha-canonicalize (rename-in-expr W5703 W5705 (hd (tl (tl V5702))))) (cons (hd V5702) (cons W5705 (cons W5706 ()))))))) ((and (cons? V5702) (and (cons? (hd V5702)) (and (= sym (hd (hd V5702))) (and (cons? (tl (hd V5702))) (and (= with (hd (tl (hd V5702)))) (and (= () (tl (tl (hd V5702)))) (and (cons? (tl V5702)) (and (cons? (tl (tl V5702))) (and (cons? (tl (tl (tl V5702)))) (= () (tl (tl (tl (tl V5702)))))))))))))) (let W5707 (ensure-bare-symbol (hd (tl V5702))) (let W5708 (hd (generate-canon-bare 1)) (let W5709 (scope-alpha-canonicalize (rename-in-expr (cons W5707 ()) (cons W5708 ()) (hd (tl (tl (tl V5702)))))) (cons (hd V5702) (cons W5708 (cons (hd (tl (tl V5702))) (cons W5709 ())))))))) ((cons? V5702) (cons (scope-alpha-canonicalize (hd V5702)) (map (lambda Z5710 (scope-alpha-canonicalize Z5710)) (tl V5702)))) (true V5702))) - -(defun alpha-canonicalize (V5711) (scope-alpha-canonicalize V5711)) - -(defun module (V5712 V5713) (let W5714 (map (lambda Z5715 (ensure-bare-symbol Z5715)) V5712) (let W5716 (generate-canon-bare (length W5714)) (let W5717 (alpha-canonicalize (rename-in-expr W5714 W5716 V5713)) (alpha-canonicalize (cons (cons sym (cons module ())) (cons W5716 (cons W5717 ())))))))) - -(defun with (V5718 V5719 V5720) (let W5721 (ensure-bare-symbol V5718) (let W5722 (hd (generate-canon-bare 1)) (let W5723 (alpha-canonicalize (rename-in-expr (cons W5721 ()) (cons W5722 ()) V5720)) (alpha-canonicalize (cons (cons sym (cons with ())) (cons W5722 (cons V5719 (cons W5723 ()))))))))) - -(defun block-bind (V5724 V5725) (if (symbol? V5724) (cons (cons sym (cons block-bind ())) (cons V5724 (cons V5725 ()))) (simple-error "block-bind: symbol only"))) - -(defun block-bind? (V5730) (cond ((and (cons? V5730) (and (cons? (hd V5730)) (and (= sym (hd (hd V5730))) (and (cons? (tl (hd V5730))) (and (= block-bind (hd (tl (hd V5730)))) (and (= () (tl (tl (hd V5730)))) (and (cons? (tl V5730)) (and (cons? (tl (tl V5730))) (= () (tl (tl (tl V5730)))))))))))) (symbol? (hd (tl V5730)))) (true false))) - -(defun block-bindings-ok? (V5735) (cond ((= () V5735) true) ((and (cons? V5735) (and (cons? (hd V5735)) (and (cons? (hd (hd V5735))) (and (= sym (hd (hd (hd V5735)))) (and (cons? (tl (hd (hd V5735)))) (and (= block-bind (hd (tl (hd (hd V5735))))) (and (= () (tl (tl (hd (hd V5735))))) (and (cons? (tl (hd V5735))) (and (cons? (tl (tl (hd V5735)))) (= () (tl (tl (tl (hd V5735)))))))))))))) (if (symbol? (hd (tl (hd V5735)))) (block-bindings-ok? (tl V5735)) false)) (true (simple-error "block-binding: only symbols allowed in binding position")))) - -(defun block (V5736 V5737) (if (block-bindings-ok? V5736) (cons (cons sym (cons block ())) (cons V5736 (cons V5737 ()))) (simple-error "block: non-symbol in binding position"))) - -(defun module? (V5744) (cond ((and (cons? V5744) (and (cons? (hd V5744)) (and (= sym (hd (hd V5744))) (and (cons? (tl (hd V5744))) (and (= module (hd (tl (hd V5744)))) (and (= () (tl (tl (hd V5744)))) (and (cons? (tl V5744)) (and (cons? (tl (tl V5744))) (= () (tl (tl (tl V5744)))))))))))) true) (true false))) - -(defun with? (V5753) (cond ((and (cons? V5753) (and (cons? (hd V5753)) (and (= sym (hd (hd V5753))) (and (cons? (tl (hd V5753))) (and (= with (hd (tl (hd V5753)))) (and (= () (tl (tl (hd V5753)))) (and (cons? (tl V5753)) (and (cons? (tl (tl V5753))) (and (cons? (tl (tl (tl V5753)))) (= () (tl (tl (tl (tl V5753)))))))))))))) true) (true false))) - -(defun block? (V5760) (cond ((and (cons? V5760) (and (cons? (hd V5760)) (and (= sym (hd (hd V5760))) (and (cons? (tl (hd V5760))) (and (= block (hd (tl (hd V5760)))) (and (= () (tl (tl (hd V5760)))) (and (cons? (tl V5760)) (and (cons? (tl (tl V5760))) (= () (tl (tl (tl V5760)))))))))))) true) (true false))) - -(pr "scope.shen (stub: Module/With/Block + hygienic gensym + alpha-for-hash tie + symbol-only block check). -" (stoutput)) - -(defun digit? (V5761) (let W5762 (string->n V5761) (and (>= W5762 48) (<= W5762 57)))) - -(defun letter? (V5763) (let W5764 (string->n V5763) (or (and (>= W5764 65) (<= W5764 90)) (and (>= W5764 97) (<= W5764 122))))) - -(defun alnum? (V5765) (or (letter? V5765) (digit? V5765))) - -(defun tokenize (V5766) (tok V5766 ())) - -(defun tok (V5767 V5768) (cond ((= "" V5767) (reverse V5768)) (true (let W5769 (pos V5767 0) (let W5770 (tlstr V5767) (cond ((= W5769 " ") (tok W5770 V5768)) ((= W5769 " ") (tok W5770 V5768)) ((= W5769 " -") (tok W5770 V5768)) ((= W5769 "[") (tok W5770 (cons lbrack V5768))) ((= W5769 "]") (tok W5770 (cons rbrack V5768))) ((= W5769 "(") (tok W5770 (cons lparen V5768))) ((= W5769 ")") (tok W5770 (cons rparen V5768))) ((= W5769 ",") (tok W5770 (cons comma V5768))) ((= W5769 "+") (tok W5770 (cons plus V5768))) ((= W5769 "*") (tok W5770 (cons star V5768))) ((= W5769 "^") (tok W5770 (cons pow V5768))) ((= W5769 "/") (tok W5770 (cons slash V5768))) ((= W5769 ":") (tok-colon V5767 V5768)) ((= W5769 "=") (tok-eq V5767 V5768)) ((= W5769 "_") (tok-blank V5767 0 V5768)) ((= W5769 "-") (tok W5770 (cons dash V5768))) ((digit? W5769) (tok-num V5767 0 V5768)) ((letter? W5769) (tok-id V5767 "" V5768)) (true (simple-error (cn "tokenize: bad char " (shen.app W5769 "" shen.a)))))))))) - -(defun tok-colon (V5771 V5772) (let W5773 (tlstr V5771) (if (and (not (= W5773 "")) (= (pos W5773 0) "=")) (tok (tlstr W5773) (cons colon-eq V5772)) (simple-error "tokenize: bare ':' (expected :=)")))) - -(defun tok-eq (V5774 V5775) (let W5776 (tlstr V5774) (if (and (not (= W5776 "")) (= (pos W5776 0) "=")) (tok (tlstr W5776) (cons eqeq V5775)) (simple-error "tokenize: bare '=' (expected ==)")))) - -(defun tok-num (V5777 V5778 V5779) (if (or (= V5777 "") (not (digit? (pos V5777 0)))) (tok V5777 (cons (cons num (cons V5778 ())) V5779)) (tok-num (tlstr V5777) (+ (* V5778 10) (- (string->n (pos V5777 0)) 48)) V5779))) - -(defun tok-id (V5780 V5781 V5782) (if (or (= V5780 "") (not (alnum? (pos V5780 0)))) (tok V5780 (cons (cons id (cons V5781 ())) V5782)) (tok-id (tlstr V5780) (@s V5781 (pos V5780 0)) V5782))) - -(defun tok-blank (V5783 V5784 V5785) (if (and (not (= V5783 "")) (= (pos V5783 0) "_")) (tok-blank (tlstr V5783) (+ V5784 1) V5785) (tok V5783 (cons (blank-token V5784) V5785)))) - -(defun blank-token (V5786) (cond ((= 1 V5786) blank1) ((= 2 V5786) blank2) ((= 3 V5786) blank3) (true (simple-error (cn "tokenize: " (shen.app V5786 " underscores (only _ __ ___)" shen.a)))))) - -(defun sym* (V5787) (sym (intern V5787))) - -(defun int* (V5788) (cas-intern! (cons int (cons V5788 ())))) - -(defun compound* (V5789 V5790) (cons V5789 V5790)) - -(defun blank-pat () (cons blank ())) - -(defun blank-seq-pat () (cons blank-seq ())) - -(defun blank-null-pat () (cons blank-null-seq ())) - -(defun named-pat (V5791 V5792) (cons named (cons V5791 (cons V5792 ())))) - -(defun make-rule (V5793 V5794) (rule V5793 V5794)) - -(defun prec (V5797) (cond ((= eqeq V5797) 1) ((= plus V5797) 2) ((= dash V5797) 2) ((= star V5797) 3) ((= slash V5797) 3) ((= pow V5797) 4) (true 0))) - -(defun left-assoc? (V5798) (or (= V5798 eqeq) (or (= V5798 plus) (or (= V5798 dash) (or (= V5798 star) (= V5798 slash)))))) - -(defun parse-expr-string (V5799) (let W5800 (tokenize V5799) (let W5801 (p-expr W5800 0) (let W5802 (hd W5801) (let W5803 (tl W5801) (if (empty? W5803) W5802 (simple-error (cn "parse-expr: trailing tokens after " (shen.app W5802 (cn " : " (shen.app W5803 "" shen.a)) shen.a))))))))) - -(defun p-expr (V5804 V5805) (let W5806 (p-factor V5804) (let W5807 (hd W5806) (let W5808 (tl W5806) (p-infix W5807 W5808 V5805))))) - -(defun p-infix (V5813 V5814 V5815) (cond ((= () V5814) (cons V5813 ())) ((cons? V5814) (if (infix-op? (hd V5814)) (let W5816 (prec (hd V5814)) (if (not (>= W5816 V5815)) (cons V5813 V5814) (let W5817 (if (left-assoc? (hd V5814)) (+ W5816 1) W5816) (let W5818 (p-expr (tl V5814) W5817) (let W5819 (hd W5818) (let W5820 (tl W5818) (let W5821 (make-infix-expr (hd V5814) V5813 W5819) (p-infix W5821 W5820 V5815)))))))) (if (factor-start? (hd V5814)) (let W5822 (prec star) (if (not (>= W5822 V5815)) (cons V5813 V5814) (let W5823 (p-expr V5814 (+ W5822 1)) (let W5824 (hd W5823) (let W5825 (tl W5823) (let W5826 (make-infix-expr star V5813 W5824) (p-infix W5826 W5825 V5815))))))) (cons V5813 V5814)))) (true (cons V5813 V5814)))) - -(defun factor-start? (V5833) (cond ((and (cons? V5833) (and (= num (hd V5833)) (and (cons? (tl V5833)) (= () (tl (tl V5833)))))) true) ((and (cons? V5833) (and (= id (hd V5833)) (and (cons? (tl V5833)) (= () (tl (tl V5833)))))) true) ((= lparen V5833) true) (true false))) - -(defun infix-op? (V5836) (cond ((= eqeq V5836) true) ((= plus V5836) true) ((= dash V5836) true) ((= star V5836) true) ((= slash V5836) true) ((= pow V5836) true) (true false))) - -(defun make-infix-expr (V5839 V5840 V5841) (cond ((= eqeq V5839) (compound* (sym* "Equal") (cons V5840 (cons V5841 ())))) ((= plus V5839) (compound* (sym* "Plus") (cons V5840 (cons V5841 ())))) ((= dash V5839) (compound* (sym* "Plus") (cons V5840 (cons (negate V5841) ())))) ((= star V5839) (compound* (sym* "Times") (cons V5840 (cons V5841 ())))) ((= slash V5839) (slash-expr V5840 V5841)) ((= pow V5839) (compound* (sym* "Power") (cons V5840 (cons V5841 ())))) (true (simple-error "bad infix")))) - -(defun negate (V5842) (cond ((and (cons? V5842) (and (= int (hd V5842)) (and (cons? (tl V5842)) (= () (tl (tl V5842)))))) (int* (* -1 (hd (tl V5842))))) ((and (cons? V5842) (and (= rat (hd V5842)) (and (cons? (tl V5842)) (and (cons? (tl (tl V5842))) (= () (tl (tl (tl V5842)))))))) (make-rat (* -1 (hd (tl V5842))) (hd (tl (tl V5842))))) (true (negate-compound V5842)))) - -(defun negate-compound (V5843) (if (times-headed? V5843) (negate-times V5843) (compound* (sym* "Times") (cons (int* -1) (cons V5843 ()))))) - -(defun times-headed? (V5848) (cond ((cons? V5848) (if (sym? (hd V5848)) (= (sym-name (hd V5848)) (intern "Times")) false)) (true false))) - -(defun negate-times (V5849) (cond ((and (cons? V5849) (cons? (tl V5849))) (if (numeric? (hd (tl V5849))) (compound* (hd V5849) (cons (negate (hd (tl V5849))) (tl (tl V5849)))) (compound* (hd V5849) (cons (int* -1) (tl V5849))))) (true (simple-error "partial function negate-times")))) - -(defun slash-expr (V5850 V5851) (cond ((and (cons? V5850) (and (= int (hd V5850)) (and (cons? (tl V5850)) (and (= () (tl (tl V5850))) (and (cons? V5851) (and (= int (hd V5851)) (and (cons? (tl V5851)) (= () (tl (tl V5851)))))))))) (make-rat (hd (tl V5850)) (hd (tl V5851)))) (true (compound* (sym* "Divide") (cons V5850 (cons V5851 ())))))) - -(defun p-factor (V5852) (cond ((and (cons? V5852) (= dash (hd V5852))) (let W5853 (p-expr (tl V5852) 4) (let W5854 (hd W5853) (let W5855 (tl W5853) (cons (negate W5854) W5855))))) ((and (cons? V5852) (and (cons? (hd V5852)) (and (= num (hd (hd V5852))) (and (cons? (tl (hd V5852))) (= () (tl (tl (hd V5852)))))))) (cons (int* (hd (tl (hd V5852)))) (tl V5852))) ((and (cons? V5852) (and (cons? (hd V5852)) (and (= id (hd (hd V5852))) (and (cons? (tl (hd V5852))) (and (= () (tl (tl (hd V5852)))) (and (cons? (tl V5852)) (= lbrack (hd (tl V5852))))))))) (let W5856 (p-arglist (tl (tl V5852))) (let W5857 (hd W5856) (let W5858 (tl W5856) (let W5859 (sym* (hd (tl (hd V5852)))) (let W5860 (compound* W5859 W5857) (if (and (cons? W5858) (= (hd W5858) rbrack)) (cons W5860 (tl W5858)) (simple-error (cn "missing ] after app " (shen.app (hd (tl (hd V5852))) "" shen.a)))))))))) ((and (cons? V5852) (and (cons? (hd V5852)) (and (= id (hd (hd V5852))) (and (cons? (tl (hd V5852))) (= () (tl (tl (hd V5852)))))))) (cons (sym* (hd (tl (hd V5852)))) (tl V5852))) ((and (cons? V5852) (= lparen (hd V5852))) (let W5861 (p-expr (tl V5852) 0) (let W5862 (hd W5861) (let W5863 (tl W5861) (if (and (cons? W5863) (= (hd W5863) rparen)) (cons W5862 (tl W5863)) (simple-error "missing ) ")))))) (true (simple-error (cn "p-factor unexpected: " (shen.app V5852 "" shen.a)))))) - -(defun p-arglist (V5864) (cond ((and (cons? V5864) (= rbrack (hd V5864))) (cons () V5864)) (true (let W5865 (p-expr V5864 0) (let W5866 (hd W5865) (let W5867 (tl W5865) (let W5868 (p-arglist-tail W5867) (let W5869 (hd W5868) (let W5870 (tl W5868) (cons (cons W5866 W5869) W5870)))))))))) - -(defun p-arglist-tail (V5871) (cond ((and (cons? V5871) (= comma (hd V5871))) (let W5872 (p-expr (tl V5871) 0) (let W5873 (hd W5872) (let W5874 (tl W5872) (let W5875 (p-arglist-tail W5874) (let W5876 (hd W5875) (let W5877 (tl W5875) (cons (cons W5873 W5876) W5877)))))))) (true (cons () V5871)))) - -(defun parse-pattern-string (V5878) (let W5879 (tokenize V5878) (let W5880 (p-pat W5879) (let W5881 (hd W5880) (let W5882 (tl W5880) (if (empty? W5882) W5881 (simple-error (cn "parse-pattern: trailing " (shen.app W5882 "" shen.a))))))))) - -(defun p-pat (V5883) (cond ((and (cons? V5883) (and (cons? (hd V5883)) (and (= id (hd (hd V5883))) (and (cons? (tl (hd V5883))) (and (= () (tl (tl (hd V5883)))) (and (cons? (tl V5883)) (= blank1 (hd (tl V5883))))))))) (cons (named-pat (intern (hd (tl (hd V5883)))) (blank-pat)) (tl (tl V5883)))) ((and (cons? V5883) (and (cons? (hd V5883)) (and (= id (hd (hd V5883))) (and (cons? (tl (hd V5883))) (and (= () (tl (tl (hd V5883)))) (and (cons? (tl V5883)) (= blank2 (hd (tl V5883))))))))) (cons (named-pat (intern (hd (tl (hd V5883)))) (blank-seq-pat)) (tl (tl V5883)))) ((and (cons? V5883) (and (cons? (hd V5883)) (and (= id (hd (hd V5883))) (and (cons? (tl (hd V5883))) (and (= () (tl (tl (hd V5883)))) (and (cons? (tl V5883)) (= blank3 (hd (tl V5883))))))))) (cons (named-pat (intern (hd (tl (hd V5883)))) (blank-null-pat)) (tl (tl V5883)))) ((and (cons? V5883) (and (cons? (hd V5883)) (and (= num (hd (hd V5883))) (and (cons? (tl (hd V5883))) (= () (tl (tl (hd V5883)))))))) (cons (int* (hd (tl (hd V5883)))) (tl V5883))) ((and (cons? V5883) (and (cons? (hd V5883)) (and (= id (hd (hd V5883))) (and (cons? (tl (hd V5883))) (and (= () (tl (tl (hd V5883)))) (and (cons? (tl V5883)) (= lbrack (hd (tl V5883))))))))) (let W5884 (p-pat-arglist (tl (tl V5883))) (let W5885 (hd W5884) (let W5886 (tl W5884) (let W5887 (sym* (hd (tl (hd V5883)))) (if (and (cons? W5886) (= (hd W5886) rbrack)) (cons (cons W5887 W5885) (tl W5886)) (simple-error "missing ] in pat app"))))))) ((and (cons? V5883) (and (cons? (hd V5883)) (and (= id (hd (hd V5883))) (and (cons? (tl (hd V5883))) (= () (tl (tl (hd V5883)))))))) (cons (sym* (hd (tl (hd V5883)))) (tl V5883))) ((and (cons? V5883) (= lparen (hd V5883))) (p-pat (tl V5883))) (true (simple-error (cn "p-pat bad " (shen.app V5883 "" shen.a)))))) - -(defun p-pat-arglist (V5888) (cond ((and (cons? V5888) (= rbrack (hd V5888))) (cons () V5888)) (true (let W5889 (p-pat V5888) (let W5890 (hd W5889) (let W5891 (tl W5889) (let W5892 (p-pat-arglist-tail W5891) (let W5893 (hd W5892) (let W5894 (tl W5892) (cons (cons W5890 W5893) W5894)))))))))) - -(defun p-pat-arglist-tail (V5895) (cond ((and (cons? V5895) (= comma (hd V5895))) (let W5896 (p-pat (tl V5895)) (let W5897 (hd W5896) (let W5898 (tl W5896) (let W5899 (p-pat-arglist-tail W5898) (let W5900 (hd W5899) (let W5901 (tl W5899) (cons (cons W5897 W5900) W5901)))))))) (true (cons () V5895)))) - -(defun parse-rule-string (V5902) (let W5903 (tokenize V5902) (let W5904 (p-pat W5903) (let W5905 (hd W5904) (let W5906 (tl W5904) (if (and (cons? W5906) (= (hd W5906) colon-eq)) (let W5907 (tl W5906) (let W5908 (p-expr W5907 0) (let W5909 (hd W5908) (let W5910 (tl W5908) (if (empty? W5910) (make-rule W5905 W5909) (simple-error "rule trailing tokens")))))) (simple-error "rule missing :="))))))) - -(defun parse-and-register-rule (V5911) (let W5912 (parse-rule-string V5911) (register-rule W5912))) - -(defun roundtrip-expr? (V5913) (let W5914 (parse-expr-string V5913) (do (pr (cn "roundtrip-parse " (shen.app V5913 (cn " -> " (shen.app (pretty-expr W5914) " -" shen.a)) shen.a)) (stoutput)) true))) - -(pr "read.shen loaded (SCUD 14.1 recursive descent reader to checked forms). -" (stoutput)) - -(defun expr-prec (V5923) (cond ((and (cons? V5923) (and (= sym (hd V5923)) (and (cons? (tl V5923)) (= () (tl (tl V5923)))))) 100) ((and (cons? V5923) (and (= int (hd V5923)) (and (cons? (tl V5923)) (= () (tl (tl V5923)))))) 100) ((and (cons? V5923) (and (= rat (hd V5923)) (and (cons? (tl V5923)) (and (cons? (tl (tl V5923))) (= () (tl (tl (tl V5923)))))))) 100) (true (if (op-headed? "Equal" V5923) 0 (if (op-headed? "Plus" V5923) 1 (if (op-headed? "Times" V5923) 2 (if (op-headed? "Divide" V5923) 2 (if (op-headed? "Power" V5923) 3 100)))))))) - -(defun op-headed? (V5928 V5929) (cond ((cons? V5929) (and (sym? (hd V5929)) (and (= (sym-name (hd V5929)) (intern V5928)) (>= (length (tl V5929)) 2)))) (true false))) - -(defun paren-if (V5930 V5931 V5932) (if (< V5931 V5930) (@s "(" (@s V5932 ")")) V5932)) - -(defun print-expr (V5933) (cond ((and (cons? V5933) (and (= int (hd V5933)) (and (cons? (tl V5933)) (= () (tl (tl V5933)))))) (str (hd (tl V5933)))) ((and (cons? V5933) (and (= rat (hd V5933)) (and (cons? (tl V5933)) (and (cons? (tl (tl V5933))) (= () (tl (tl (tl V5933)))))))) (@s (str (hd (tl V5933))) (@s "/" (str (hd (tl (tl V5933))))))) ((and (cons? V5933) (and (= sym (hd V5933)) (and (cons? (tl V5933)) (= () (tl (tl V5933)))))) (str (hd (tl V5933)))) ((or (named? V5933) (or (blank? V5933) (or (blank-seq? V5933) (blank-null-seq? V5933)))) (print-pattern V5933)) ((op-headed? "Equal" V5933) (print-equal V5933)) ((op-headed? "Plus" V5933) (print-plus V5933)) ((op-headed? "Times" V5933) (print-times V5933)) ((op-headed? "Divide" V5933) (print-divide V5933)) ((op-headed? "Power" V5933) (print-power V5933)) ((cons? V5933) (@s (print-expr (hd V5933)) (@s "[" (@s (print-args (tl V5933)) "]")))) (true (simple-error (cn "print-expr: unsupported " (shen.app V5933 "" shen.a)))))) - -(defun print-infix (V5936 V5937 V5938 V5939 V5940) (cond ((cons? V5940) (join-infix V5936 V5937 V5938 V5939 (tl V5940))) (true (simple-error "partial function print-infix")))) - -(defun join-infix (V5945 V5946 V5947 V5948 V5949) (cond ((and (cons? V5949) (= () (tl V5949))) (paren-if V5947 (expr-prec (hd V5949)) (print-expr (hd V5949)))) ((cons? V5949) (@s (paren-if V5947 (expr-prec (hd V5949)) (print-expr (hd V5949))) (@s V5945 (join-infix V5945 V5946 V5948 V5948 (tl V5949))))) (true (simple-error "partial function join-infix")))) - -(defun numeric-neg? (V5954) (cond ((and (cons? V5954) (and (= int (hd V5954)) (and (cons? (tl V5954)) (= () (tl (tl V5954)))))) (< (hd (tl V5954)) 0)) ((and (cons? V5954) (and (= rat (hd V5954)) (and (cons? (tl V5954)) (and (cons? (tl (tl V5954))) (= () (tl (tl (tl V5954)))))))) (< (hd (tl V5954)) 0)) (true false))) - -(defun times-coeff (V5957) (cond ((cons? V5957) (find-coeff (tl V5957))) (true (simple-error "partial function times-coeff")))) - -(defun find-coeff (V5958) (cond ((= () V5958) (cons int (cons 1 ()))) ((cons? V5958) (if (numeric? (hd V5958)) (hd V5958) (find-coeff (tl V5958)))) (true (simple-error "partial function find-coeff")))) - -(defun times-others (V5961) (cond ((cons? V5961) (drop-first-numeric (tl V5961))) (true (simple-error "partial function times-others")))) - -(defun drop-first-numeric (V5962) (cond ((= () V5962) ()) ((cons? V5962) (if (numeric? (hd V5962)) (tl V5962) (cons (hd V5962) (drop-first-numeric (tl V5962))))) (true (simple-error "partial function drop-first-numeric")))) - -(defun negate-num (V5963) (cond ((and (cons? V5963) (and (= int (hd V5963)) (and (cons? (tl V5963)) (= () (tl (tl V5963)))))) (cons int (cons (* -1 (hd (tl V5963))) ()))) ((and (cons? V5963) (and (= rat (hd V5963)) (and (cons? (tl V5963)) (and (cons? (tl (tl V5963))) (= () (tl (tl (tl V5963)))))))) (cons rat (cons (* -1 (hd (tl V5963))) (tl (tl V5963))))) (true (simple-error "partial function negate-num")))) - -(defun neg-coeff? (V5966) (cond ((and (cons? V5966) (and (= int (hd V5966)) (and (cons? (tl V5966)) (= () (tl (tl V5966)))))) (< (hd (tl V5966)) 0)) ((and (cons? V5966) (and (= rat (hd V5966)) (and (cons? (tl V5966)) (and (cons? (tl (tl V5966))) (= () (tl (tl (tl V5966)))))))) (< (hd (tl V5966)) 0)) (true (if (op-headed? "Times" V5966) (numeric-neg? (times-coeff V5966)) false)))) - -(defun pos-of (V5967) (cond ((and (cons? V5967) (and (= int (hd V5967)) (and (cons? (tl V5967)) (= () (tl (tl V5967)))))) (cons int (cons (* -1 (hd (tl V5967))) ()))) ((and (cons? V5967) (and (= rat (hd V5967)) (and (cons? (tl V5967)) (and (cons? (tl (tl V5967))) (= () (tl (tl (tl V5967)))))))) (cons rat (cons (* -1 (hd (tl V5967))) (tl (tl V5967))))) (true (rebuild-times (negate-num (times-coeff V5967)) (times-others V5967))))) - -(defun rebuild-times (V5968 V5969) (cond ((and (cons? V5968) (and (= int (hd V5968)) (and (cons? (tl V5968)) (and (= 1 (hd (tl V5968))) (and (= () (tl (tl V5968))) (and (cons? V5969) (= () (tl V5969)))))))) (hd V5969)) ((and (cons? V5968) (and (= int (hd V5968)) (and (cons? (tl V5968)) (and (= 1 (hd (tl V5968))) (= () (tl (tl V5968))))))) (cons (times-head-sym) V5969)) (true (cons (times-head-sym) (cons V5968 V5969))))) - -(defun times-head-sym () (cons sym (cons (intern "Times") ()))) - -(defun print-equal (V5972) (cond ((and (cons? V5972) (and (cons? (tl V5972)) (and (cons? (tl (tl V5972))) (= () (tl (tl (tl V5972))))))) (@s (paren-if 1 (expr-prec (hd (tl V5972))) (print-expr (hd (tl V5972)))) (@s "=" (@s "=" (paren-if 1 (expr-prec (hd (tl (tl V5972)))) (print-expr (hd (tl (tl V5972))))))))) (true (simple-error "partial function print-equal")))) - -(defun print-plus (V5975) (cond ((cons? V5975) (pp-terms (tl V5975) true)) (true (simple-error "partial function print-plus")))) - -(defun pp-terms (V5978 V5979) (cond ((= () V5978) "") ((cons? V5978) (let W5980 (neg-coeff? (hd V5978)) (let W5981 (if W5980 (print-addend (pos-of (hd V5978))) (print-addend (hd V5978))) (let W5982 (if V5979 (if W5980 "-" "") (if W5980 "-" "+")) (@s W5982 (@s W5981 (pp-terms (tl V5978) false))))))) (true (simple-error "partial function pp-terms")))) - -(defun print-addend (V5983) (paren-if 2 (expr-prec V5983) (print-expr V5983))) - -(defun print-times (V5984) (let W5985 (times-coeff V5984) (let W5986 (times-others V5984) (if (numeric-neg? W5985) (@s "-" (print-times-body (negate-num W5985) W5986)) (print-times-body W5985 W5986))))) - -(defun print-times-body (V5987 V5988) (cond ((and (cons? V5987) (and (= int (hd V5987)) (and (cons? (tl V5987)) (and (= 1 (hd (tl V5987))) (= () (tl (tl V5987))))))) (print-product V5988)) (true (@s (print-expr V5987) (@s "*" (print-product V5988)))))) - -(defun print-product (V5989) (cond ((= () V5989) "") ((and (cons? V5989) (= () (tl V5989))) (paren-if 3 (expr-prec (hd V5989)) (print-expr (hd V5989)))) ((cons? V5989) (@s (paren-if 3 (expr-prec (hd V5989)) (print-expr (hd V5989))) (@s "*" (print-product (tl V5989))))) (true (simple-error "partial function print-product")))) - -(defun print-divide (V5992) (cond ((and (cons? V5992) (and (cons? (tl V5992)) (and (cons? (tl (tl V5992))) (= () (tl (tl (tl V5992))))))) (@s (paren-if 2 (expr-prec (hd (tl V5992))) (print-expr (hd (tl V5992)))) (@s "/" (paren-if 3 (expr-prec (hd (tl (tl V5992)))) (print-expr (hd (tl (tl V5992)))))))) (true (simple-error "partial function print-divide")))) - -(defun print-power (V5995) (cond ((and (cons? V5995) (and (cons? (tl V5995)) (and (cons? (tl (tl V5995))) (= () (tl (tl (tl V5995))))))) (@s (paren-if 4 (expr-prec (hd (tl V5995))) (print-expr (hd (tl V5995)))) (@s "^" (print-power-exponent (hd (tl (tl V5995))))))) (true (simple-error "partial function print-power")))) - -(defun print-power-exponent (V5996) (cond ((and (cons? V5996) (and (= rat (hd V5996)) (and (cons? (tl V5996)) (and (cons? (tl (tl V5996))) (= () (tl (tl (tl V5996)))))))) (@s "(" (@s (print-expr V5996) ")"))) (true (paren-if 3 (expr-prec V5996) (print-expr V5996))))) - -(defun print-args (V5997) (cond ((= () V5997) "") ((and (cons? V5997) (= () (tl V5997))) (print-expr (hd V5997))) ((cons? V5997) (@s (print-expr (hd V5997)) (@s "," (print-args (tl V5997))))) (true (simple-error "partial function print-args")))) - -(defun print-pattern (V5998) (if (named? V5998) (print-named (named-name V5998) (named-subpattern V5998)) (if (blank? V5998) "_" (if (blank-seq? V5998) "__" (if (blank-null-seq? V5998) "___" (simple-error (cn "print-pattern: " (shen.app V5998 "" shen.a)))))))) - -(defun print-named (V5999 V6000) (@s (str V5999) (blank-suffix V6000))) - -(defun blank-suffix (V6001) (if (blank? V6001) "_" (if (blank-seq? V6001) "__" (if (blank-null-seq? V6001) "___" (simple-error (cn "blank-suffix: " (shen.app V6001 "" shen.a))))))) - -(pr "print.shen loaded (round-trippable printer). -" (stoutput)) - diff --git a/crates/shenffi/cas/cas-kernel.kl b/crates/shenffi/cas/cas-kernel.kl deleted file mode 100644 index 9638e6e..0000000 --- a/crates/shenffi/cas/cas-kernel.kl +++ /dev/null @@ -1,1272 +0,0 @@ -(defun shen.shen->kl (V531) (let W532 (shen.shen->kl-h V531) (shen.record-and-evaluate W532))) - -(defun shen.record-and-evaluate (V533) (cond ((and (cons? V533) (and (= defun (hd V533)) (and (cons? (tl V533)) (and (cons? (tl (tl V533))) (and (cons? (tl (tl (tl V533)))) (= () (tl (tl (tl (tl V533)))))))))) (let W534 (if (shen.sysfunc? (hd (tl V533))) (simple-error (shen.app (hd (tl V533)) " is not a legitimate function name -" shen.a)) shen.skip) (let W535 (shen.store-arity (hd (tl V533)) (length (hd (tl (tl V533))))) (let W536 (shen.record-kl (hd (tl V533)) V533) (let W537 (eval-kl V533) (shen.fn-print (hd (tl V533)))))))) (true V533))) - -(defun shen.shen->kl-h (V538) (cond ((and (cons? V538) (and (= define (hd V538)) (cons? (tl V538)))) (shen.shendef->kldef (hd (tl V538)) (tl (tl V538)))) ((and (cons? V538) (and (= defun (hd V538)) (and (cons? (tl V538)) (and (cons? (tl (tl V538))) (and (cons? (tl (tl (tl V538)))) (= () (tl (tl (tl (tl V538)))))))))) V538) ((and (cons? V538) (and (= type (hd V538)) (and (cons? (tl V538)) (and (cons? (tl (tl V538))) (= () (tl (tl (tl V538)))))))) (cons type (cons (hd (tl V538)) (cons (shen.rcons_form (hd (tl (tl V538)))) ())))) ((and (cons? V538) (and (= input+ (hd V538)) (and (cons? (tl V538)) (and (cons? (tl (tl V538))) (= () (tl (tl (tl V538)))))))) (cons input+ (cons (shen.rcons_form (hd (tl V538))) (tl (tl V538))))) ((cons? V538) (map (lambda Z539 (shen.shen->kl-h Z539)) V538)) (true V538))) - -(defun shen.shendef->kldef (V540 V541) (compile (lambda Z542 (shen. Z542)) (cons V540 V541))) - -(defun shen. (V543) (let W544 (let W545 (shen. V543) (if (shen.parse-failure? W545) (shen.parse-failure) (let W546 (shen.<-out W545) (let W547 (shen.in-> W545) (if (shen.hds=? W547 {) (let W548 (tail W547) (let W549 (shen. W548) (if (shen.parse-failure? W549) (shen.parse-failure) (let W550 (shen.in-> W549) (if (shen.hds=? W550 }) (let W551 (tail W550) (let W552 (shen. W551) (if (shen.parse-failure? W552) (shen.parse-failure) (let W553 (shen.<-out W552) (let W554 (shen.in-> W552) (shen.comb W554 (shen.shendef->kldef-h W546 W553))))))) (shen.parse-failure)))))) (shen.parse-failure)))))) (if (shen.parse-failure? W544) (let W555 (let W556 (shen. V543) (if (shen.parse-failure? W556) (shen.parse-failure) (let W557 (shen.<-out W556) (let W558 (shen.in-> W556) (let W559 (shen. W558) (if (shen.parse-failure? W559) (shen.parse-failure) (let W560 (shen.<-out W559) (let W561 (shen.in-> W559) (shen.comb W561 (shen.shendef->kldef-h W557 W560)))))))))) (if (shen.parse-failure? W555) (shen.parse-failure) W555)) W544))) - -(defun shen.shendef->kldef-h (V562 V563) (let W564 (map (lambda Z565 (fst Z565)) V563) (let W566 (shen.arity-chk V562 W564) (let W567 (map (lambda Z568 (shen.free-var-chk V562 Z568)) V563) (let W569 (shen.unprotect V563) (let W570 (shen.factorise-code (shen.compile-to-kl V562 W569 W566)) W570)))))) - -(defun shen.unprotect (V571) (cond ((tuple? V571) (@p (shen.unprotect (fst V571)) (shen.unprotect (snd V571)))) ((and (cons? V571) (and (= protect (hd V571)) (and (cons? (tl V571)) (= () (tl (tl V571)))))) (shen.unprotect (hd (tl V571)))) ((cons? V571) (map (lambda Z572 (shen.unprotect Z572)) V571)) (true V571))) - -(defun shen. (V573) (let W574 (if (cons? V573) (let W575 (head V573) (let W576 (tail V573) (shen.comb W576 (if (and (symbol? W575) (not (variable? W575))) W575 (simple-error (shen.app W575 " is not a legitimate function name. -" shen.a)))))) (shen.parse-failure)) (if (shen.parse-failure? W574) (shen.parse-failure) W574))) - -(defun shen. (V577) (let W578 (if (cons? V577) (let W579 (head V577) (let W580 (tail V577) (let W581 (shen. W580) (if (shen.parse-failure? W581) (shen.parse-failure) (let W582 (shen.<-out W581) (let W583 (shen.in-> W581) (if (not (element? W579 (cons { (cons } ())))) (shen.comb W583 (cons W579 W582)) (shen.parse-failure)))))))) (shen.parse-failure)) (if (shen.parse-failure? W578) (let W584 (let W585 ( V577) (if (shen.parse-failure? W585) (shen.parse-failure) (let W586 (shen.in-> W585) (shen.comb W586 ())))) (if (shen.parse-failure? W584) (shen.parse-failure) W584)) W578))) - -(defun shen. (V587) (let W588 (let W589 (shen. V587) (if (shen.parse-failure? W589) (shen.parse-failure) (let W590 (shen.<-out W589) (let W591 (shen.in-> W589) (let W592 (shen. W591) (if (shen.parse-failure? W592) (shen.parse-failure) (let W593 (shen.<-out W592) (let W594 (shen.in-> W592) (shen.comb W594 (cons (shen.linearise W590) W593)))))))))) (if (shen.parse-failure? W588) (let W595 (let W596 ( V587) (if (shen.parse-failure? W596) (shen.parse-failure) (let W597 (shen.<-out W596) (let W598 (shen.in-> W596) (shen.comb W598 (if (empty? W597) () (simple-error (cn "Shen syntax error here: - " (shen.app W597 " - ..." shen.r))))))))) (if (shen.parse-failure? W595) (shen.parse-failure) W595)) W588))) - -(defun shen.linearise (V601) (cond ((tuple? V601) (shen.linearise-h (fst V601) (fst V601) () (snd V601))) (true (simple-error "implementation error in shen.linearise")))) - -(defun shen.linearise-h (V614 V615 V616 V617) (cond ((= () V614) (@p V615 V617)) ((and (cons? V614) (cons? (hd V614))) (shen.linearise-h (append (hd V614) (tl V614)) V615 V616 V617)) ((and (cons? V614) (variable? (hd V614))) (if (element? (hd V614) V616) (let W618 (gensym V) (shen.linearise-h (tl V614) (shen.rep-X (hd V614) W618 V615) V616 (cons where (cons (cons = (cons W618 (cons (hd V614) ()))) (cons V617 ()))))) (shen.linearise-h (tl V614) V615 (cons (hd V614) V616) V617))) ((cons? V614) (shen.linearise-h (tl V614) V615 V616 V617)) (true (simple-error "implementation error in shen.linearise-h")))) - -(defun shen. (V619) (let W620 (let W621 (shen. V619) (if (shen.parse-failure? W621) (shen.parse-failure) (let W622 (shen.<-out W621) (let W623 (shen.in-> W621) (if (shen.hds=? W623 ->) (let W624 (tail W623) (if (cons? W624) (let W625 (head W624) (let W626 (tail W624) (if (shen.hds=? W626 where) (let W627 (tail W626) (if (cons? W627) (let W628 (head W627) (let W629 (tail W627) (shen.comb W629 (@p W622 (cons where (cons W628 (cons W625 ()))))))) (shen.parse-failure))) (shen.parse-failure)))) (shen.parse-failure))) (shen.parse-failure)))))) (if (shen.parse-failure? W620) (let W630 (let W631 (shen. V619) (if (shen.parse-failure? W631) (shen.parse-failure) (let W632 (shen.<-out W631) (let W633 (shen.in-> W631) (if (shen.hds=? W633 ->) (let W634 (tail W633) (if (cons? W634) (let W635 (head W634) (let W636 (tail W634) (shen.comb W636 (@p W632 W635)))) (shen.parse-failure))) (shen.parse-failure)))))) (if (shen.parse-failure? W630) (let W637 (let W638 (shen. V619) (if (shen.parse-failure? W638) (shen.parse-failure) (let W639 (shen.<-out W638) (let W640 (shen.in-> W638) (if (shen.hds=? W640 <-) (let W641 (tail W640) (if (cons? W641) (let W642 (head W641) (let W643 (tail W641) (if (shen.hds=? W643 where) (let W644 (tail W643) (if (cons? W644) (let W645 (head W644) (let W646 (tail W644) (shen.comb W646 (@p W639 (cons where (cons W645 (cons (cons shen.choicepoint! (cons W642 ())) ()))))))) (shen.parse-failure))) (shen.parse-failure)))) (shen.parse-failure))) (shen.parse-failure)))))) (if (shen.parse-failure? W637) (let W647 (let W648 (shen. V619) (if (shen.parse-failure? W648) (shen.parse-failure) (let W649 (shen.<-out W648) (let W650 (shen.in-> W648) (if (shen.hds=? W650 <-) (let W651 (tail W650) (if (cons? W651) (let W652 (head W651) (let W653 (tail W651) (shen.comb W653 (@p W649 (cons shen.choicepoint! (cons W652 ())))))) (shen.parse-failure))) (shen.parse-failure)))))) (if (shen.parse-failure? W647) (shen.parse-failure) W647)) W637)) W630)) W620))) - -(defun shen. (V654) (let W655 (let W656 (shen. V654) (if (shen.parse-failure? W656) (shen.parse-failure) (let W657 (shen.<-out W656) (let W658 (shen.in-> W656) (let W659 (shen. W658) (if (shen.parse-failure? W659) (shen.parse-failure) (let W660 (shen.<-out W659) (let W661 (shen.in-> W659) (shen.comb W661 (cons W657 W660)))))))))) (if (shen.parse-failure? W655) (let W662 (let W663 ( V654) (if (shen.parse-failure? W663) (shen.parse-failure) (let W664 (shen.in-> W663) (shen.comb W664 ())))) (if (shen.parse-failure? W662) (shen.parse-failure) W662)) W655))) - -(defun shen. (V665) (let W666 (if (shen.ccons? V665) (let W667 (head V665) (let W668 (tail V665) (if (shen.hds=? W667 vector) (let W669 (tail W667) (if (shen.hds=? W669 0) (let W670 (tail W669) (let W671 ( W670) (if (shen.parse-failure? W671) (shen.parse-failure) (let W672 (shen.in-> W671) (shen.comb W668 (cons vector (cons 0 ()))))))) (shen.parse-failure))) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W666) (let W673 (if (cons? V665) (let W674 (head V665) (let W675 (tail V665) (if (cons? W674) (shen.comb W675 (shen.compound-pattern W674)) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W673) (let W676 (let W677 (shen. V665) (if (shen.parse-failure? W677) (shen.parse-failure) (let W678 (shen.<-out W677) (let W679 (shen.in-> W677) (shen.comb W679 W678))))) (if (shen.parse-failure? W676) (shen.parse-failure) W676)) W673)) W666))) - -(defun shen.constructor? (V684) (element? V684 (cons cons (cons @p (cons @s (cons @v ())))))) - -(defun shen.constructor-error (V685) (simple-error (shen.app V685 " is not a legitimate constructor -" shen.r))) - -(defun shen.custom-pattern-compiler (V686 V687) (let W688 (value shen.*custom-pattern-compiler*) (if (= W688 false) (thaw V687) ((W688 V686) V687)))) - -(defun shen.custom-pattern-reducer (V689) (let W690 (value shen.*custom-pattern-reducer*) (if (= W690 false) (fail) (W690 V689)))) - -(defun shen.compound-pattern (V691) (shen.custom-pattern-compiler V691 (freeze (shen.compound-pattern-h V691)))) - -(defun shen.compound-pattern-h (V692) (cond ((and (cons? V692) (and (cons? (tl V692)) (and (cons? (tl (tl V692))) (and (= () (tl (tl (tl V692)))) (shen.constructor? (hd V692)))))) (cons (hd V692) (cons (shen.compile-pattern-fragment (hd (tl V692))) (cons (shen.compile-pattern-fragment (hd (tl (tl V692)))) ())))) (true (shen.constructor-error V692)))) - -(defun shen.compile-pattern-fragment (V693) (cond ((and (cons? V693) (and (= vector (hd V693)) (and (cons? (tl V693)) (and (= 0 (hd (tl V693))) (= () (tl (tl V693))))))) V693) ((cons? V693) (shen.compound-pattern V693)) ((= V693 _) (gensym Y)) ((not (element? V693 (cons -> (cons <- ())))) V693) (true (shen.constructor-error V693)))) - -(defun shen.custom-pattern? (V698) (cond ((and (cons? V698) (and (= @p (hd V698)) (and (cons? (tl V698)) (and (= shen.custom-pattern (hd (tl V698))) (and (cons? (tl (tl V698))) (= () (tl (tl (tl V698))))))))) true) (true false))) - -(defun shen.custom-pattern-body (V701) (cond ((and (cons? V701) (and (= @p (hd V701)) (and (cons? (tl V701)) (and (= shen.custom-pattern (hd (tl V701))) (and (cons? (tl (tl V701))) (= () (tl (tl (tl V701))))))))) (hd (tl (tl V701)))) (true (simple-error "implementation error in shen.custom-pattern-body")))) - -(defun shen. (V702) (let W703 (if (cons? V702) (let W704 (head V702) (let W705 (tail V702) (if (= W704 _) (shen.comb W705 (gensym Y)) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W703) (let W706 (if (cons? V702) (let W707 (head V702) (let W708 (tail V702) (if (not (element? W707 (cons -> (cons <- ())))) (shen.comb W708 W707) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W706) (shen.parse-failure) W706)) W703))) - -(defun shen.fn-print (V719) (let W720 (absvector 2) (let W721 (address-> W720 0 shen.printF) (let W722 (address-> W721 1 (@s "(" (@s "f" (@s "n" (@s " " (@s (str V719) ")")))))) W722)))) - -(defun shen.printF (V723) (<-address V723 1)) - -(defun shen.arity-chk (V728 V729) (cond ((and (cons? V729) (= () (tl V729))) (length (hd V729))) ((and (cons? V729) (and (cons? (tl V729)) (= (length (hd V729)) (length (hd (tl V729)))))) (shen.arity-chk V728 (tl V729))) (true (simple-error (cn "arity error in " (shen.app V728 " -" shen.a)))))) - -(defun shen.free-var-chk (V730 V731) (cond ((tuple? V731) (shen.free-variable-error-message V730 (shen.find-free-vars (shen.extract-vars (fst V731)) (snd V731)))) (true (shen.f-error shen.free-var-chk)))) - -(defun shen.free-variable-error-message (V732 V733) (if (empty? V733) shen.skip (do (pr (cn "free variables in " (shen.app V732 ":" shen.a)) (stoutput)) (do (shen.for-each (lambda Z734 (pr (cn " " (shen.app Z734 "" shen.a)) (stoutput))) V733) (do (nl 1) (abort)))))) - -(defun shen.extract-vars (V737) (cond ((variable? V737) (cons V737 ())) ((cons? V737) (union (shen.extract-vars (hd V737)) (shen.extract-vars (tl V737)))) (true ()))) - -(defun shen.find-free-vars (V742 V743) (cond ((and (cons? V743) (and (= protect (hd V743)) (and (cons? (tl V743)) (= () (tl (tl V743)))))) ()) ((and (cons? V743) (and (= let (hd V743)) (and (cons? (tl V743)) (and (cons? (tl (tl V743))) (and (cons? (tl (tl (tl V743)))) (= () (tl (tl (tl (tl V743)))))))))) (union (shen.find-free-vars V742 (hd (tl (tl V743)))) (shen.find-free-vars (cons (hd (tl V743)) V742) (hd (tl (tl (tl V743))))))) ((and (cons? V743) (and (= lambda (hd V743)) (and (cons? (tl V743)) (and (cons? (tl (tl V743))) (= () (tl (tl (tl V743)))))))) (shen.find-free-vars (cons (hd (tl V743)) V742) (hd (tl (tl V743))))) ((cons? V743) (union (shen.find-free-vars V742 (hd V743)) (shen.find-free-vars V742 (tl V743)))) ((shen.free-variable? V743 V742) (cons V743 ())) (true ()))) - -(defun shen.free-variable? (V744 V745) (and (variable? V744) (not (element? V744 V745)))) - -(defun shen.record-kl (V746 V747) (do (set shen.*userdefs* (adjoin V746 (value shen.*userdefs*))) (put V746 shen.source V747 (value *property-vector*)))) - -(defun shen.compile-to-kl (V748 V749 V750) (let W751 (shen.parameters V750) (let W752 (shen.scan-body V748 (shen.kl-body V749 W751)) (let W753 (cons defun (cons V748 (cons W751 (cons (shen.cond-form W752) ())))) W753)))) - -(defun shen.parameters (V754) (cond ((= 0 V754) ()) (true (cons (gensym V) (shen.parameters (- V754 1)))))) - -(defun shen.cond-form (V757) (cond ((and (cons? V757) (and (cons? (hd V757)) (and (= true (hd (hd V757))) (and (cons? (tl (hd V757))) (= () (tl (tl (hd V757)))))))) (hd (tl (hd V757)))) (true (cons cond V757)))) - -(defun shen.scan-body (V766 V767) (cond ((= () V767) (cons (cons true (cons (cons shen.f-error (cons V766 ())) ())) ())) ((and (cons? V767) (shen.choicepoint? (hd V767))) (shen.choicepoint V766 (gensym Freeze) (gensym Result) (hd V767) (tl V767))) ((and (cons? V767) (and (cons? (hd V767)) (and (= true (hd (hd V767))) (and (cons? (tl (hd V767))) (= () (tl (tl (hd V767)))))))) (cons (hd V767) ())) ((cons? V767) (cons (hd V767) (shen.scan-body V766 (tl V767)))) (true (simple-error "implementation error in shen.scan-body")))) - -(defun shen.choicepoint? (V774) (cond ((and (cons? V774) (and (cons? (tl V774)) (and (cons? (hd (tl V774))) (and (= shen.choicepoint! (hd (hd (tl V774)))) (and (cons? (tl (hd (tl V774)))) (and (= () (tl (tl (hd (tl V774))))) (= () (tl (tl V774))))))))) true) (true false))) - -(defun shen.choicepoint (V790 V791 V792 V793 V794) (cond ((and (cons? V793) (and (cons? (tl V793)) (and (cons? (hd (tl V793))) (and (cons? (tl (hd (tl V793)))) (and (cons? (hd (tl (hd (tl V793))))) (and (= fail-if (hd (hd (tl (hd (tl V793)))))) (and (cons? (tl (hd (tl (hd (tl V793)))))) (and (cons? (tl (tl (hd (tl (hd (tl V793))))))) (and (= () (tl (tl (tl (hd (tl (hd (tl V793)))))))) (and (= () (tl (tl (hd (tl V793))))) (and (= () (tl (tl V793))) (= V790 (hd (tl (hd (tl (hd (tl V793)))))))))))))))))) (cons (cons true (cons (cons let (cons V791 (cons (cons freeze (cons (cons cond (shen.scan-body (hd (tl (hd (tl (hd (tl V793)))))) V794)) ())) (cons (cons if (cons (hd V793) (cons (cons let (cons V792 (cons (hd (tl (tl (hd (tl (hd (tl V793))))))) (cons (cons if (cons (cons (hd (tl (hd (tl (hd (tl V793)))))) (cons V792 ())) (cons (cons thaw (cons V791 ())) (cons V792 ())))) ())))) (cons (cons thaw (cons V791 ())) ())))) ())))) ())) ())) ((and (cons? V793) (and (cons? (tl V793)) (and (cons? (hd (tl V793))) (and (cons? (tl (hd (tl V793)))) (and (= () (tl (tl (hd (tl V793))))) (= () (tl (tl V793)))))))) (cons (cons true (cons (cons let (cons V791 (cons (cons freeze (cons (cons cond (shen.scan-body V790 V794)) ())) (cons (cons if (cons (hd V793) (cons (cons let (cons V792 (cons (hd (tl (hd (tl V793)))) (cons (cons if (cons (cons = (cons V792 (cons (cons fail ()) ()))) (cons (cons thaw (cons V791 ())) (cons V792 ())))) ())))) (cons (cons thaw (cons V791 ())) ())))) ())))) ())) ())) (true (simple-error "implementation error in shen.choicepoint")))) - -(defun shen.rep-X (V796 V797 V798) (cond ((= V796 V798) V797) ((cons? V798) (let W799 (shen.rep-X V796 V797 (hd V798)) (if (= W799 (hd V798)) (cons (hd V798) (shen.rep-X V796 V797 (tl V798))) (cons W799 (tl V798))))) (true V798))) - -(defun shen.alpha-convert (V800) (cond ((and (cons? V800) (and (= lambda (hd V800)) (and (cons? (tl V800)) (and (cons? (tl (tl V800))) (= () (tl (tl (tl V800)))))))) (let W801 (gensym Z) (let W802 (cons lambda (cons W801 (cons (shen.beta (hd (tl V800)) W801 (hd (tl (tl V800)))) ()))) (map (lambda Z803 (shen.alpha-convert Z803)) W802)))) ((and (cons? V800) (and (= let (hd V800)) (and (cons? (tl V800)) (and (cons? (tl (tl V800))) (and (cons? (tl (tl (tl V800)))) (= () (tl (tl (tl (tl V800)))))))))) (let W804 (gensym W) (let W805 (cons let (cons W804 (cons (hd (tl (tl V800))) (cons (shen.beta (hd (tl V800)) W804 (hd (tl (tl (tl V800))))) ())))) (map (lambda Z806 (shen.alpha-convert Z806)) W805)))) ((cons? V800) (map (lambda Z807 (shen.alpha-convert Z807)) V800)) (true V800))) - -(defun shen.kl-body (V808 V809) (map (lambda Z810 (shen.triple-stack () (fst Z810) V809 (shen.alpha-convert (snd Z810)))) V808)) - -(defun shen.triple-stack (V819 V820 V821 V822) (cond ((and (= () V820) (and (= () V821) (and (cons? V822) (and (= where (hd V822)) (and (cons? (tl V822)) (and (cons? (tl (tl V822))) (= () (tl (tl (tl V822)))))))))) (shen.triple-stack (cons (hd (tl V822)) V819) () () (hd (tl (tl V822))))) ((and (= () V820) (= () V821)) (cons (shen.rectify-test (reverse V819)) (cons V822 ()))) ((and (cons? V820) (and (cons? V821) (variable? (hd V820)))) (shen.triple-stack V819 (tl V820) (tl V821) (shen.beta (hd V820) (hd V821) V822))) ((and (cons? V820) (and (cons? V821) (shen.custom-pattern? (hd V820)))) (shen.custom-pattern-triple-stack V819 (shen.custom-pattern-body (hd V820)) (tl V820) (hd V821) (tl V821) V822)) ((and (cons? V820) (and (cons? (hd V820)) (and (cons? (tl (hd V820))) (and (cons? (tl (tl (hd V820)))) (and (= () (tl (tl (tl (hd V820))))) (and (cons? V821) (shen.constructor? (hd (hd V820))))))))) (shen.triple-stack (cons (cons (shen.op-test (hd (hd V820))) (cons (hd V821) ())) V819) (cons (hd (tl (hd V820))) (cons (hd (tl (tl (hd V820)))) (tl V820))) (cons (cons (shen.op1 (hd (hd V820))) (cons (hd V821) ())) (cons (cons (shen.op2 (hd (hd V820))) (cons (hd V821) ())) (tl V821))) (shen.beta (hd V820) (hd V821) V822))) ((and (cons? V820) (cons? V821)) (shen.triple-stack (cons (cons = (cons (hd V820) (cons (hd V821) ()))) V819) (tl V820) (tl V821) V822)) (true (simple-error "implementation error in shen.triple-stack")))) - -(defun shen.custom-pattern-triple-stack (V823 V824 V825 V826 V827 V828) (let W829 (shen.custom-pattern-reducer (@p V824 V826)) (if (tuple? W829) (let W830 (fst W829) (let W831 (snd W829) (shen.triple-stack (append (reverse W830) V823) (append (map (lambda Z832 (fst Z832)) W831) V825) (append (map (lambda Z833 (snd Z833)) W831) V827) (shen.beta V824 V826 V828)))) (shen.constructor-error V824)))) - -(defun shen.rectify-test (V836) (cond ((= () V836) true) ((and (cons? V836) (= () (tl V836))) (hd V836)) ((and (cons? V836) (cons? (tl V836))) (cons and (cons (hd V836) (cons (shen.rectify-test (tl V836)) ())))) (true (simple-error "implementation error in shen.rectify-test")))) - -(defun shen.beta (V846 V847 V848) (cond ((= V846 V848) V847) ((and (cons? V848) (and (= lambda (hd V848)) (and (cons? (tl V848)) (and (cons? (tl (tl V848))) (and (= () (tl (tl (tl V848)))) (= V846 (hd (tl V848)))))))) V848) ((and (cons? V848) (and (= let (hd V848)) (and (cons? (tl V848)) (and (cons? (tl (tl V848))) (and (cons? (tl (tl (tl V848)))) (and (= () (tl (tl (tl (tl V848))))) (= V846 (hd (tl V848))))))))) (cons let (cons (hd (tl V848)) (cons (shen.beta (hd (tl V848)) V847 (hd (tl (tl V848)))) (tl (tl (tl V848))))))) ((cons? V848) (map (lambda Z849 (shen.beta V846 V847 Z849)) V848)) (true V848))) - -(defun shen.op1 (V852) (cond ((= cons V852) hd) ((= @s V852) hdstr) ((= @p V852) fst) ((= @v V852) hdv) (true (simple-error "implementation error in shen.op1")))) - -(defun shen.op2 (V855) (cond ((= cons V855) tl) ((= @s V855) tlstr) ((= @p V855) snd) ((= @v V855) tlv) (true (simple-error "implementation error in shen.op2")))) - -(defun shen.op-test (V858) (cond ((= cons V858) cons?) ((= @s V858) shen.+string?) ((= @p V858) tuple?) ((= @v V858) shen.+vector?) (true (simple-error "implementation error in shen.op-test")))) - -(defun shen.+string? (V859) (cond ((= "" V859) false) (true (string? V859)))) - -(defun shen.+vector? (V860) (cond ((= V860 (vector 0)) false) (true (vector? V860)))) - -(defun shen.factorise-code (V864) (cond ((value shen.*factorise?*) (shen.factor V864)) (true V864))) - -(defun shen.factor (V865) (cond ((and (cons? V865) (and (= defun (hd V865)) (and (cons? (tl V865)) (and (cons? (tl (tl V865))) (and (cons? (tl (tl (tl V865)))) (and (cons? (hd (tl (tl (tl V865))))) (and (= cond (hd (hd (tl (tl (tl V865)))))) (= () (tl (tl (tl (tl V865)))))))))))) (cons defun (cons (hd (tl V865)) (cons (hd (tl (tl V865))) (cons (shen.factor-recognisors (tl (hd (tl (tl (tl V865)))))) ()))))) (true V865))) - -(defun shen.factor-recognisors (V868) (cond ((and (cons? V868) (and (cons? (hd V868)) (and (= true (hd (hd V868))) (and (cons? (tl (hd V868))) (= () (tl (tl (hd V868)))))))) (hd (tl (hd V868)))) ((and (cons? V868) (and (cons? (hd V868)) (and (cons? (hd (hd V868))) (and (= and (hd (hd (hd V868)))) (and (cons? (tl (hd (hd V868)))) (and (cons? (tl (tl (hd (hd V868))))) (and (= () (tl (tl (tl (hd (hd V868)))))) (and (cons? (tl (hd V868))) (= () (tl (tl (hd V868)))))))))))) (let W869 (shen.pivot-on (hd (tl (hd (hd V868)))) V868 ()) (let W870 (fst W869) (if (shen.bad-pivot? W870) (cons if (cons (hd (hd V868)) (cons (hd (tl (hd V868))) (cons (shen.factor-recognisors (tl V868)) ())))) (let W871 (snd W869) (let W872 (shen.factor-recognisors W871) (let W873 (gensym GoTo) (let W874 (reverse (cons (cons true (cons (cons thaw (cons W873 ())) ())) W870)) (let W875 (cons let (cons W873 (cons (cons freeze (cons W872 ())) (cons (cons if (cons (hd (tl (hd (hd V868)))) (cons (shen.factor-selectors (hd (tl (hd (hd V868)))) (shen.factor-recognisors W874)) (cons (cons thaw (cons W873 ())) ())))) ())))) (shen.remove-indirection W875)))))))))) ((and (cons? V868) (and (cons? (hd V868)) (and (cons? (tl (hd V868))) (= () (tl (tl (hd V868))))))) (cons if (cons (hd (hd V868)) (cons (hd (tl (hd V868))) (cons (shen.factor-recognisors (tl V868)) ()))))) (true (shen.f-error shen.factor-recognisors)))) - -(defun shen.bad-pivot? (V880) (cond ((and (cons? V880) (= () (tl V880))) true) (true false))) - -(defun shen.remove-indirection (V881) (cond ((and (cons? V881) (and (= let (hd V881)) (and (cons? (tl V881)) (and (cons? (tl (tl V881))) (and (cons? (hd (tl (tl V881)))) (and (= freeze (hd (hd (tl (tl V881))))) (and (cons? (tl (hd (tl (tl V881))))) (and (cons? (hd (tl (hd (tl (tl V881)))))) (and (= thaw (hd (hd (tl (hd (tl (tl V881))))))) (and (cons? (tl (hd (tl (hd (tl (tl V881))))))) (and (= () (tl (tl (hd (tl (hd (tl (tl V881)))))))) (and (= () (tl (tl (hd (tl (tl V881)))))) (and (cons? (tl (tl (tl V881)))) (and (= () (tl (tl (tl (tl V881))))) (symbol? (hd (tl (hd (tl (hd (tl (tl V881)))))))))))))))))))))) (subst (hd (tl (hd (tl (hd (tl (tl V881))))))) (hd (tl V881)) (hd (tl (tl (tl V881)))))) (true V881))) - -(defun shen.pivot-on (V884 V885 V886) (cond ((and (cons? V885) (and (cons? (hd V885)) (and (cons? (hd (hd V885))) (and (= and (hd (hd (hd V885)))) (and (cons? (tl (hd (hd V885)))) (and (cons? (tl (tl (hd (hd V885))))) (and (= () (tl (tl (tl (hd (hd V885)))))) (and (cons? (tl (hd V885))) (and (= () (tl (tl (hd V885)))) (= V884 (hd (tl (hd (hd V885)))))))))))))) (shen.pivot-on (hd (tl (hd (hd V885)))) (tl V885) (cons (cons (hd (tl (tl (hd (hd V885))))) (tl (hd V885))) V886))) ((and (cons? V885) (and (cons? (hd V885)) (and (cons? (tl (hd V885))) (and (= () (tl (tl (hd V885)))) (= V884 (hd (hd V885))))))) (shen.pivot-on (hd (hd V885)) (tl V885) (cons (cons true (tl (hd V885))) V886))) (true (@p V886 V885)))) - -(defun shen.factor-selectors (V889 V890) (cond ((and (cons? V889) (and (cons? (tl V889)) (= () (tl (tl V889))))) (let W891 (shen.op (hd V889)) (if (= shen.skip W891) V890 (shen.factor-selectors-h (cons (cons (shen.op1 W891) (tl V889)) (cons (cons (shen.op2 W891) (tl V889)) ())) V890)))) (true V890))) - -(defun shen.op (V894) (cond ((= cons? V894) cons) ((= shen.+string? V894) @s) ((= shen.+vector? V894) @v) ((= tuple? V894) @p) (true shen.skip))) - -(defun shen.factor-selectors-h (V895 V896) (cond ((= () V895) V896) ((cons? V895) (if (> (occurrences (hd V895) V896) 1) (let W897 (gensym Select) (cons let (cons W897 (cons (hd V895) (cons (shen.factor-selectors-h (tl V895) (subst W897 (hd V895) V896)) ()))))) (shen.factor-selectors-h (tl V895) V896))) (true (shen.f-error shen.factor-selectors-h)))) - -(defun thaw (V3767) (V3767)) - -(defun eval (V3768) (eval-kl (shen.shen->kl (shen.process-applications (macroexpand V3768) (shen.find-types V3768))))) - -(defun external (V3769) (cond ((= null V3769) ()) (true (trap-error (get V3769 shen.external-symbols (value *property-vector*)) (lambda Z3770 (simple-error (cn "package " (shen.app V3769 " does not exist. -;" shen.a)))))))) - -(defun fail-if (V3773 V3774) (if (V3773 V3774) (fail) V3774)) - -(defun @s (V3775 V3776) (cn V3775 V3776)) - -(defun ps (V3777) (trap-error (get V3777 shen.source (value *property-vector*)) (lambda Z3778 (simple-error (shen.app V3777 " not found. -" shen.a))))) - -(defun stinput () (value *stinput*)) - -(defun vector (V3779) (let W3780 (absvector (+ V3779 1)) (let W3781 (address-> W3780 0 V3779) (let W3782 (if (= V3779 0) W3781 (shen.fillvector W3781 1 V3779 (fail))) W3782)))) - -(defun shen.fillvector (V3784 V3785 V3786 V3787) (cond ((= V3785 V3786) (address-> V3784 V3786 V3787)) (true (shen.fillvector (address-> V3784 V3785 V3787) (+ 1 V3785) V3786 V3787)))) - -(defun vector? (V3788) (and (absvector? V3788) (let W3789 (trap-error (<-address V3788 0) (lambda Z3790 -1)) (and (number? W3789) (>= W3789 0))))) - -(defun vector-> (V3791 V3792 V3793) (if (= V3792 0) (simple-error "cannot access 0th element of a vector -") (address-> V3791 V3792 V3793))) - -(defun <-vector (V3794 V3795) (if (= V3795 0) (simple-error "cannot access 0th element of a vector -") (let W3796 (<-address V3794 V3795) (if (= W3796 (fail)) (simple-error "vector element not found -") W3796)))) - -(defun limit (V3798) (<-address V3798 0)) - -(defun symbol? (V3799) (cond ((or (boolean? V3799) (or (number? V3799) (or (string? V3799) (or (cons? V3799) (or (empty? V3799) (vector? V3799)))))) false) ((element? V3799 (cons { (cons } (cons (intern ":") (cons (intern ";") (cons (intern ",") ())))))) true) (true (trap-error (let W3800 (str V3799) (shen.analyse-symbol? W3800)) (lambda Z3801 false))))) - -(defun shen.analyse-symbol? (V3804) (cond ((shen.+string? V3804) (and (shen.alpha? (string->n (hdstr V3804))) (shen.alphanums? (tlstr V3804)))) (true (simple-error "implementation error in shen.analyse-symbol?")))) - -(defun shen.alphanums? (V3807) (cond ((= "" V3807) true) ((shen.+string? V3807) (let W3808 (string->n (hdstr V3807)) (and (or (shen.alpha? W3808) (shen.digit? W3808)) (shen.alphanums? (tlstr V3807))))) (true (simple-error "implementation error in shen.alphanums?")))) - -(defun variable? (V3809) (cond ((or (boolean? V3809) (or (number? V3809) (string? V3809))) false) (true (trap-error (let W3810 (str V3809) (shen.analyse-variable? W3810)) (lambda Z3811 false))))) - -(defun shen.analyse-variable? (V3814) (cond ((shen.+string? V3814) (and (shen.uppercase? (string->n (hdstr V3814))) (shen.alphanums? (tlstr V3814)))) (true (simple-error "implementation error in shen.analyse-variable?")))) - -(defun gensym (V3815) (concat V3815 (set shen.*gensym* (+ 1 (value shen.*gensym*))))) - -(defun concat (V3816 V3817) (intern (cn (str V3816) (str V3817)))) - -(defun @p (V3818 V3819) (let W3820 (absvector 3) (let W3821 (address-> W3820 0 shen.tuple) (let W3822 (address-> W3820 1 V3818) (let W3823 (address-> W3820 2 V3819) W3820))))) - -(defun fst (V3824) (<-address V3824 1)) - -(defun snd (V3825) (<-address V3825 2)) - -(defun tuple? (V3826) (and (absvector? V3826) (= shen.tuple (trap-error (<-address V3826 0) (lambda Z3827 shen.not-tuple))))) - -(defun append (V3832 V3833) (cond ((= () V3832) V3833) ((cons? V3832) (cons (hd V3832) (append (tl V3832) V3833))) (true (simple-error "attempt to append a non-list")))) - -(defun @v (V3834 V3835) (let W3836 (limit V3835) (let W3837 (vector (+ W3836 1)) (let W3838 (vector-> W3837 1 V3834) (if (= W3836 0) W3838 (shen.@v-help V3835 1 W3836 W3838)))))) - -(defun shen.@v-help (V3840 V3841 V3842 V3843) (cond ((= V3841 V3842) (shen.copyfromvector V3840 V3843 V3842 (+ V3842 1))) (true (shen.@v-help V3840 (+ V3841 1) V3842 (shen.copyfromvector V3840 V3843 V3841 (+ V3841 1)))))) - -(defun shen.copyfromvector (V3844 V3845 V3846 V3847) (trap-error (vector-> V3845 V3847 (<-vector V3844 V3846)) (lambda Z3848 V3845))) - -(defun hdv (V3849) (trap-error (<-vector V3849 1) (lambda Z3850 (simple-error "hdv needs a non-empty vector as an argument -")))) - -(defun tlv (V3851) (let W3852 (limit V3851) (if (= W3852 0) (simple-error "cannot take the tail of the empty vector -") (if (= W3852 1) (vector 0) (let W3853 (vector (- W3852 1)) (shen.tlv-help V3851 2 W3852 (vector (- W3852 1)))))))) - -(defun shen.tlv-help (V3855 V3856 V3857 V3858) (cond ((= V3856 V3857) (shen.copyfromvector V3855 V3858 V3857 (- V3857 1))) (true (shen.tlv-help V3855 (+ V3856 1) V3857 (shen.copyfromvector V3855 V3858 V3856 (- V3856 1)))))) - -(defun assoc (V3870 V3871) (cond ((= () V3871) ()) ((and (cons? V3871) (and (cons? (hd V3871)) (= V3870 (hd (hd V3871))))) (hd V3871)) ((cons? V3871) (assoc V3870 (tl V3871))) (true (simple-error "attempt to search a non-list with assoc -")))) - -(defun shen.assoc-set (V3875 V3876 V3877) (cond ((= () V3877) (cons (cons V3875 V3876) ())) ((and (cons? V3877) (and (cons? (hd V3877)) (= V3875 (hd (hd V3877))))) (cons (cons (hd (hd V3877)) V3876) (tl V3877))) ((cons? V3877) (cons (hd V3877) (shen.assoc-set V3875 V3876 (tl V3877)))) (true (shen.f-error shen.assoc-set)))) - -(defun shen.assoc-rm (V3881 V3882) (cond ((= () V3882) ()) ((and (cons? V3882) (and (cons? (hd V3882)) (= V3881 (hd (hd V3882))))) (tl V3882)) ((cons? V3882) (cons (hd V3882) (shen.assoc-rm V3881 (tl V3882)))) (true (shen.f-error shen.assoc-rm)))) - -(defun boolean? (V3885) (cond ((= true V3885) true) ((= false V3885) true) (true false))) - -(defun nl (V3886) (cond ((= 0 V3886) 0) (true (do (pr " -" (stoutput)) (nl (- V3886 1)))))) - -(defun difference (V3893 V3894) (cond ((= () V3893) ()) ((cons? V3893) (if (element? (hd V3893) V3894) (difference (tl V3893) V3894) (cons (hd V3893) (difference (tl V3893) V3894)))) (true (simple-error "attempt to find the difference with a non-list -")))) - -(defun do (V3895 V3896) V3896) - -(defun element? (V3908 V3909) (cond ((= () V3909) false) ((and (cons? V3909) (= V3908 (hd V3909))) true) ((cons? V3909) (element? V3908 (tl V3909))) (true (simple-error "attempt to find an element in a non-list -")))) - -(defun empty? (V3912) (cond ((= () V3912) true) (true false))) - -(defun put (V3923 V3924 V3925 V3926) (let W3927 (trap-error (shen.<-dict V3926 V3923) (lambda Z3928 ())) (let W3929 (shen.assoc-set V3924 V3925 W3927) (let W3930 (shen.dict-> V3926 V3923 W3929) V3925)))) - -(defun unput (V3931 V3932 V3933) (let W3934 (trap-error (shen.<-dict V3933 V3931) (lambda Z3935 ())) (let W3936 (shen.assoc-rm V3932 W3934) (let W3937 (shen.dict-> V3933 V3931 W3936) V3931)))) - -(defun get (V3938 V3939 V3940) (let W3941 (trap-error (shen.<-dict V3940 V3938) (lambda Z3942 (simple-error (shen.app V3938 (cn " has no attributes: " (shen.app V3939 " -" shen.s)) shen.a)))) (let W3943 (assoc V3939 W3941) (if (empty? W3943) (simple-error (cn "attribute " (shen.app V3939 (cn " not found for " (shen.app V3938 " -" shen.s)) shen.s))) (tl W3943))))) - -(defun hash (V3944 V3945) (let W3946 (shen.mod (shen.hashkey V3944) V3945) (if (= W3946 0) 1 W3946))) - -(defun shen.hashkey (V3947) (let W3948 (map (lambda Z3949 (string->n Z3949)) (explode V3947)) (shen.prodbutzero W3948 1))) - -(defun shen.prodbutzero (V3950 V3951) (cond ((= () V3950) V3951) ((and (cons? V3950) (= 0 (hd V3950))) (shen.prodbutzero (tl V3950) V3951)) ((cons? V3950) (if (> V3951 10000000000) (shen.prodbutzero (tl V3950) (+ V3951 (hd V3950))) (shen.prodbutzero (tl V3950) (* V3951 (hd V3950))))) (true (shen.f-error shen.prodbutzero)))) - -(defun shen.mod (V3952 V3953) (shen.modh V3952 (shen.multiples V3952 (cons V3953 ())))) - -(defun shen.multiples (V3958 V3959) (cond ((and (cons? V3959) (> (hd V3959) V3958)) (tl V3959)) ((cons? V3959) (shen.multiples V3958 (cons (* 2 (hd V3959)) V3959))) (true (simple-error "implementation error in shen.multiples")))) - -(defun shen.modh (V3966 V3967) (cond ((= 0 V3966) 0) ((= () V3967) V3966) ((and (cons? V3967) (> (hd V3967) V3966)) (if (empty? (tl V3967)) V3966 (shen.modh V3966 (tl V3967)))) ((cons? V3967) (shen.modh (- V3966 (hd V3967)) V3967)) (true (simple-error "implementation error in shen.modh")))) - -(defun head (V3975) (cond ((cons? V3975) (hd V3975)) (true (simple-error "head expects a non-empty list -")))) - -(defun tail (V3980) (cond ((cons? V3980) (tl V3980)) (true (simple-error "tail expects a non-empty list -")))) - -(defun hdstr (V3981) (pos V3981 0)) - -(defun reverse (V3990) (shen.reverse-help V3990 ())) - -(defun shen.reverse-help (V3995 V3996) (cond ((= () V3995) V3996) ((cons? V3995) (shen.reverse-help (tl V3995) (cons (hd V3995) V3996))) (true (simple-error "attempt to reverse a non-list -")))) - -(defun union (V4001 V4002) (cond ((= () V4001) V4002) ((cons? V4001) (if (element? (hd V4001) V4002) (union (tl V4001) V4002) (cons (hd V4001) (union (tl V4001) V4002)))) (true (simple-error "attempt to find the union with a non-list -")))) - -(defun y-or-n? (V4003) (let W4004 (pr (shen.proc-nl V4003) (stoutput)) (let W4005 (pr " (y/n) " (stoutput)) (let W4006 (shen.app (read (stinput)) "" shen.s) (if (= "y" W4006) true (if (= "n" W4006) false (do (pr "please answer y or n -" (stoutput)) (y-or-n? V4003)))))))) - -(defun not (V4007) (if V4007 false true)) - -(defun abort () (simple-error "")) - -(defun subst (V4013 V4014 V4015) (cond ((= V4014 V4015) V4013) ((cons? V4015) (cons (subst V4013 V4014 (hd V4015)) (subst V4013 V4014 (tl V4015)))) (true V4015))) - -(defun explode (V4016) (shen.explode-h (shen.app V4016 "" shen.a))) - -(defun shen.explode-h (V4019) (cond ((= "" V4019) ()) ((shen.+string? V4019) (cons (hdstr V4019) (shen.explode-h (tlstr V4019)))) (true (simple-error "implementation error in explode-h")))) - -(defun shen.for-each (V4021 V4022) (cond ((= () V4022) true) ((cons? V4022) (let W4023 (V4021 (hd V4022)) (shen.for-each V4021 (tl V4022)))) (true (shen.f-error shen.for-each)))) - -(defun map (V4024 V4025) (shen.map-h V4024 V4025 ())) - -(defun shen.map-h (V4026 V4027 V4028) (cond ((= () V4027) (reverse V4028)) ((cons? V4027) (shen.map-h V4026 (tl V4027) (cons (V4026 (hd V4027)) V4028))) (true (shen.f-error shen.map-h)))) - -(defun length (V4029) (shen.length-h V4029 0)) - -(defun shen.length-h (V4034 V4035) (cond ((= () V4034) V4035) (true (shen.length-h (tl V4034) (+ V4035 1))))) - -(defun occurrences (V4041 V4042) (cond ((= V4041 V4042) 1) ((cons? V4042) (+ (occurrences V4041 (hd V4042)) (occurrences V4041 (tl V4042)))) (true 0))) - -(defun integer? (V4049) (and (number? V4049) (let W4050 (shen.abs V4049) (shen.integer-test? W4050 (shen.magless W4050 1))))) - -(defun shen.abs (V4051) (if (> V4051 0) V4051 (- 0 V4051))) - -(defun shen.magless (V4052 V4053) (let W4054 (* V4053 2) (if (> W4054 V4052) V4053 (shen.magless V4052 W4054)))) - -(defun shen.integer-test? (V4058 V4059) (cond ((= 0 V4058) true) ((> 1 V4058) false) (true (let W4060 (- V4058 V4059) (if (> 0 W4060) (integer? V4058) (shen.integer-test? W4060 V4059)))))) - -(defun mapcan (V4067 V4068) (cond ((= () V4068) ()) ((cons? V4068) (append (V4067 (hd V4068)) (mapcan V4067 (tl V4068)))) (true (simple-error "attempt to mapcan over a non-list -")))) - -(defun bound? (V4076) (and (symbol? V4076) (let W4077 (trap-error (value V4076) (lambda Z4078 shen.this-symbol-is-unbound)) (if (= W4077 shen.this-symbol-is-unbound) false true)))) - -(defun inferences () (value shen.*infs*)) - -(defun protect (V4081) V4081) - -(defun stoutput () (value *stoutput*)) - -(defun fail () shen.fail!) - -(defun destroy (V4098) (do (set shen.*sigf* (shen.unassoc V4098 (value shen.*sigf*))) V4098)) - -(defun shen.unassoc (V4108 V4109) (cond ((= () V4109) ()) ((and (cons? V4109) (and (cons? (hd V4109)) (= V4108 (hd (hd V4109))))) (tl V4109)) ((cons? V4109) (cons (hd V4109) (shen.unassoc V4108 (tl V4109)))) (true (simple-error "implementation error in shen.unassoc")))) - -(defun shen.dict (V4162) (cond ((< V4162 1) (simple-error (cn "invalid initial dict size: " (shen.app V4162 "" shen.s)))) (true (let W4163 (absvector (+ 3 V4162)) (let W4164 (address-> W4163 0 shen.dictionary) (let W4165 (address-> W4163 1 V4162) (let W4166 (address-> W4163 2 0) (let W4167 (shen.fillvector W4163 3 (+ 2 V4162) ()) W4163)))))))) - -(defun shen.dict-capacity (V4170) (<-address V4170 1)) - -(defun shen.dict-count (V4171) (<-address V4171 2)) - -(defun shen.dict-count-> (V4172 V4173) (address-> V4172 2 V4173)) - -(defun shen.<-dict-bucket (V4174 V4175) (<-address V4174 (+ 3 V4175))) - -(defun shen.dict-bucket-> (V4176 V4177 V4178) (address-> V4176 (+ 3 V4177) V4178)) - -(defun shen.dict-update-count (V4179 V4180 V4181) (let W4182 (- (length V4181) (length V4180)) (shen.dict-count-> V4179 (+ W4182 (shen.dict-count V4179))))) - -(defun shen.dict-> (V4183 V4184 V4185) (let W4186 (hash V4184 (shen.dict-capacity V4183)) (let W4187 (shen.<-dict-bucket V4183 W4186) (let W4188 (shen.assoc-set V4184 V4185 W4187) (let W4189 (shen.dict-bucket-> V4183 W4186 W4188) (let W4190 (shen.dict-update-count V4183 W4187 W4188) V4185)))))) - -(defun shen.<-dict (V4191 V4192) (let W4193 (hash V4192 (shen.dict-capacity V4191)) (let W4194 (shen.<-dict-bucket V4191 W4193) (let W4195 (assoc V4192 W4194) (if (empty? W4195) (simple-error (cn "value " (shen.app V4192 " not found in dict -" shen.a))) (tl W4195)))))) - -(defun shen. (V3365) (let W3366 (if (cons? V3365) (let W3367 (head V3365) (let W3368 (tail V3365) (let W3369 (shen. W3368) (if (shen.parse-failure? W3369) (shen.parse-failure) (let W3370 (shen.<-out W3369) (let W3371 (shen.in-> W3369) (shen.comb W3371 (let W3372 (shen.rules->prolog W3367 W3370) (shen.remember-datatype W3367 (fn W3367)))))))))) (shen.parse-failure)) (if (shen.parse-failure? W3366) (shen.parse-failure) W3366))) - -(defun shen.remember-datatype (V3373 V3374) (do (set shen.*datatypes* (shen.assoc-> V3373 V3374 (value shen.*datatypes*))) (do (set shen.*alldatatypes* (shen.assoc-> V3373 V3374 (value shen.*alldatatypes*))) V3373))) - -(defun shen. (V3375) (let W3376 (let W3377 (shen. V3375) (if (shen.parse-failure? W3377) (shen.parse-failure) (let W3378 (shen.<-out W3377) (let W3379 (shen.in-> W3377) (let W3380 (shen. W3379) (if (shen.parse-failure? W3380) (shen.parse-failure) (let W3381 (shen.<-out W3380) (let W3382 (shen.in-> W3380) (shen.comb W3382 (append W3378 W3381)))))))))) (if (shen.parse-failure? W3376) (let W3383 (let W3384 ( V3375) (if (shen.parse-failure? W3384) (shen.parse-failure) (let W3385 (shen.<-out W3384) (let W3386 (shen.in-> W3384) (shen.comb W3386 (if (empty? W3385) () (simple-error (cn "datatype syntax error here: - " (shen.app W3385 " - ..." shen.r))))))))) (if (shen.parse-failure? W3383) (shen.parse-failure) W3383)) W3376))) - -(defun shen. (V3387) (let W3388 (let W3389 (shen. V3387) (if (shen.parse-failure? W3389) (shen.parse-failure) (let W3390 (shen.<-out W3389) (let W3391 (shen.in-> W3389) (shen.comb W3391 W3390))))) (if (shen.parse-failure? W3388) (let W3392 (let W3393 (shen. V3387) (if (shen.parse-failure? W3393) (shen.parse-failure) (let W3394 (shen.<-out W3393) (let W3395 (shen.in-> W3393) (shen.comb W3395 W3394))))) (if (shen.parse-failure? W3392) (shen.parse-failure) W3392)) W3388))) - -(defun shen. (V3396) (let W3397 (let W3398 (shen. V3396) (if (shen.parse-failure? W3398) (shen.parse-failure) (let W3399 (shen.<-out W3398) (let W3400 (shen.in-> W3398) (let W3401 (shen. W3400) (if (shen.parse-failure? W3401) (shen.parse-failure) (let W3402 (shen.<-out W3401) (let W3403 (shen.in-> W3401) (let W3404 (shen. W3403) (if (shen.parse-failure? W3404) (shen.parse-failure) (let W3405 (shen.in-> W3404) (let W3406 (shen. W3405) (if (shen.parse-failure? W3406) (shen.parse-failure) (let W3407 (shen.<-out W3406) (let W3408 (shen.in-> W3406) (let W3409 (shen. W3408) (if (shen.parse-failure? W3409) (shen.parse-failure) (let W3410 (shen.in-> W3409) (shen.comb W3410 (cons (cons W3399 (cons W3402 (cons W3407 ()))) ())))))))))))))))))))) (if (shen.parse-failure? W3397) (shen.parse-failure) W3397))) - -(defun shen. (V3411) (let W3412 (let W3413 (shen. V3411) (if (shen.parse-failure? W3413) (shen.parse-failure) (let W3414 (shen.<-out W3413) (let W3415 (shen.in-> W3413) (let W3416 (shen. W3415) (if (shen.parse-failure? W3416) (shen.parse-failure) (let W3417 (shen.<-out W3416) (let W3418 (shen.in-> W3416) (let W3419 (shen. W3418) (if (shen.parse-failure? W3419) (shen.parse-failure) (let W3420 (shen.in-> W3419) (let W3421 (shen. W3420) (if (shen.parse-failure? W3421) (shen.parse-failure) (let W3422 (shen.<-out W3421) (let W3423 (shen.in-> W3421) (let W3424 (shen. W3423) (if (shen.parse-failure? W3424) (shen.parse-failure) (let W3425 (shen.in-> W3424) (shen.comb W3425 (shen.lr-rule W3414 W3417 (cons () (cons W3422 ())))))))))))))))))))))) (if (shen.parse-failure? W3412) (shen.parse-failure) W3412))) - -(defun shen. (V3426) (let W3427 (let W3428 (shen. V3426) (if (shen.parse-failure? W3428) (shen.parse-failure) (let W3429 (shen.<-out W3428) (let W3430 (shen.in-> W3428) (let W3431 (shen. W3430) (if (shen.parse-failure? W3431) (shen.parse-failure) (let W3432 (shen.in-> W3431) (let W3433 (shen. W3432) (if (shen.parse-failure? W3433) (shen.parse-failure) (let W3434 (shen.<-out W3433) (let W3435 (shen.in-> W3433) (shen.comb W3435 (cons (cons () (cons W3429 ())) W3434))))))))))))) (if (shen.parse-failure? W3427) (let W3436 (let W3437 (shen. V3426) (if (shen.parse-failure? W3437) (shen.parse-failure) (let W3438 (shen.<-out W3437) (let W3439 (shen.in-> W3437) (let W3440 (shen. W3439) (if (shen.parse-failure? W3440) (shen.parse-failure) (let W3441 (shen.in-> W3440) (shen.comb W3441 (cons (cons () (cons W3438 ())) ()))))))))) (if (shen.parse-failure? W3436) (shen.parse-failure) W3436)) W3427))) - -(defun shen. (V3442) (let W3443 (let W3444 (shen. V3442) (if (shen.parse-failure? W3444) (shen.parse-failure) (let W3445 (shen.<-out W3444) (let W3446 (shen.in-> W3444) (if (shen.hds=? W3446 >>) (let W3447 (tail W3446) (let W3448 (shen. W3447) (if (shen.parse-failure? W3448) (shen.parse-failure) (let W3449 (shen.<-out W3448) (let W3450 (shen.in-> W3448) (shen.comb W3450 (cons W3445 (cons W3449 ())))))))) (shen.parse-failure)))))) (if (shen.parse-failure? W3443) (let W3451 (let W3452 (shen. V3442) (if (shen.parse-failure? W3452) (shen.parse-failure) (let W3453 (shen.<-out W3452) (let W3454 (shen.in-> W3452) (shen.comb W3454 (cons () (cons W3453 ()))))))) (if (shen.parse-failure? W3451) (shen.parse-failure) W3451)) W3443))) - -(defun shen. (V3455) (let W3456 (let W3457 (shen. V3455) (if (shen.parse-failure? W3457) (shen.parse-failure) (let W3458 (shen.<-out W3457) (let W3459 (shen.in-> W3457) (let W3460 (shen. W3459) (if (shen.parse-failure? W3460) (shen.parse-failure) (let W3461 (shen.in-> W3460) (let W3462 (shen. W3461) (if (shen.parse-failure? W3462) (shen.parse-failure) (let W3463 (shen.<-out W3462) (let W3464 (shen.in-> W3462) (shen.comb W3464 (cons W3458 W3463))))))))))))) (if (shen.parse-failure? W3456) (let W3465 (let W3466 ( V3455) (if (shen.parse-failure? W3466) (shen.parse-failure) (let W3467 (shen.in-> W3466) (shen.comb W3467 ())))) (if (shen.parse-failure? W3465) (shen.parse-failure) W3465)) W3456))) - -(defun shen. (V3468) (let W3469 (if (shen.hds=? V3468 !) (let W3470 (tail V3468) (shen.comb W3470 !)) (shen.parse-failure)) (if (shen.parse-failure? W3469) (let W3471 (let W3472 (shen. V3468) (if (shen.parse-failure? W3472) (shen.parse-failure) (let W3473 (shen.<-out W3472) (let W3474 (shen.in-> W3472) (if (shen.hds=? W3474 >>) (let W3475 (tail W3474) (let W3476 (shen. W3475) (if (shen.parse-failure? W3476) (shen.parse-failure) (let W3477 (shen.<-out W3476) (let W3478 (shen.in-> W3476) (shen.comb W3478 (cons W3473 (cons W3477 ())))))))) (shen.parse-failure)))))) (if (shen.parse-failure? W3471) (let W3479 (let W3480 (shen. V3468) (if (shen.parse-failure? W3480) (shen.parse-failure) (let W3481 (shen.<-out W3480) (let W3482 (shen.in-> W3480) (shen.comb W3482 (cons () (cons W3481 ()))))))) (if (shen.parse-failure? W3479) (shen.parse-failure) W3479)) W3471)) W3469))) - -(defun shen. (V3483) (let W3484 (let W3485 (shen. V3483) (if (shen.parse-failure? W3485) (shen.parse-failure) (let W3486 (shen.<-out W3485) (let W3487 (shen.in-> W3485) (let W3488 (shen. W3487) (if (shen.parse-failure? W3488) (shen.parse-failure) (let W3489 (shen.in-> W3488) (let W3490 (shen. W3489) (if (shen.parse-failure? W3490) (shen.parse-failure) (let W3491 (shen.<-out W3490) (let W3492 (shen.in-> W3490) (shen.comb W3492 (cons W3486 W3491))))))))))))) (if (shen.parse-failure? W3484) (let W3493 (let W3494 (shen. V3483) (if (shen.parse-failure? W3494) (shen.parse-failure) (let W3495 (shen.<-out W3494) (let W3496 (shen.in-> W3494) (shen.comb W3496 (cons W3495 ())))))) (if (shen.parse-failure? W3493) (let W3497 (let W3498 ( V3483) (if (shen.parse-failure? W3498) (shen.parse-failure) (let W3499 (shen.in-> W3498) (shen.comb W3499 ())))) (if (shen.parse-failure? W3497) (shen.parse-failure) W3497)) W3493)) W3484))) - -(defun shen. (V3500) (let W3501 (if (cons? V3500) (let W3502 (head V3500) (let W3503 (tail V3500) (if (= W3502 (intern ",")) (shen.comb W3503 shen.skip) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W3501) (shen.parse-failure) W3501))) - -(defun shen. (V3504) (let W3505 (let W3506 (shen. V3504) (if (shen.parse-failure? W3506) (shen.parse-failure) (let W3507 (shen.<-out W3506) (let W3508 (shen.in-> W3506) (let W3509 (shen. W3508) (if (shen.parse-failure? W3509) (shen.parse-failure) (let W3510 (shen.in-> W3509) (let W3511 (shen. W3510) (if (shen.parse-failure? W3511) (shen.parse-failure) (let W3512 (shen.<-out W3511) (let W3513 (shen.in-> W3511) (shen.comb W3513 (cons (shen.curry W3507) (cons (intern ":") (cons (shen.rectify-type W3512) ()))))))))))))))) (if (shen.parse-failure? W3505) (let W3514 (let W3515 (shen. V3504) (if (shen.parse-failure? W3515) (shen.parse-failure) (let W3516 (shen.<-out W3515) (let W3517 (shen.in-> W3515) (shen.comb W3517 W3516))))) (if (shen.parse-failure? W3514) (shen.parse-failure) W3514)) W3505))) - -(defun shen. (V3518) (let W3519 (if (cons? V3518) (let W3520 (head V3518) (let W3521 (tail V3518) (if (= W3520 (intern ":")) (shen.comb W3521 shen.skip) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W3519) (shen.parse-failure) W3519))) - -(defun shen. (V3522) (let W3523 (let W3524 (shen. V3522) (if (shen.parse-failure? W3524) (shen.parse-failure) (let W3525 (shen.<-out W3524) (let W3526 (shen.in-> W3524) (let W3527 (shen. W3526) (if (shen.parse-failure? W3527) (shen.parse-failure) (let W3528 (shen.<-out W3527) (let W3529 (shen.in-> W3527) (shen.comb W3529 (cons W3525 W3528)))))))))) (if (shen.parse-failure? W3523) (let W3530 (let W3531 ( V3522) (if (shen.parse-failure? W3531) (shen.parse-failure) (let W3532 (shen.in-> W3531) (shen.comb W3532 ())))) (if (shen.parse-failure? W3530) (shen.parse-failure) W3530)) W3523))) - -(defun shen. (V3533) (let W3534 (if (shen.hds=? V3533 if) (let W3535 (tail V3533) (if (cons? W3535) (let W3536 (head W3535) (let W3537 (tail W3535) (shen.comb W3537 (cons if (cons W3536 ()))))) (shen.parse-failure))) (shen.parse-failure)) (if (shen.parse-failure? W3534) (let W3538 (if (shen.hds=? V3533 let) (let W3539 (tail V3533) (if (cons? W3539) (let W3540 (head W3539) (let W3541 (tail W3539) (if (cons? W3541) (let W3542 (head W3541) (let W3543 (tail W3541) (shen.comb W3543 (cons let (cons W3540 (cons W3542 ())))))) (shen.parse-failure)))) (shen.parse-failure))) (shen.parse-failure)) (if (shen.parse-failure? W3538) (let W3544 (if (shen.hds=? V3533 ctxt) (let W3545 (tail V3533) (if (cons? W3545) (let W3546 (head W3545) (let W3547 (tail W3545) (if (variable? W3546) (shen.comb W3547 (cons ctxt (cons W3546 ()))) (shen.parse-failure)))) (shen.parse-failure))) (shen.parse-failure)) (if (shen.parse-failure? W3544) (shen.parse-failure) W3544)) W3538)) W3534))) - -(defun shen.lr-rule (V3554 V3555 V3556) (cond ((and (cons? V3556) (and (= () (hd V3556)) (and (cons? (tl V3556)) (= () (tl (tl V3556)))))) (let W3557 (gensym P) (let W3558 (cons (tl V3556) (cons W3557 ())) (let W3559 (cons (shen.coll-formulae V3555) (cons W3557 ())) (let W3560 (cons V3554 (cons (cons W3559 ()) (cons W3558 ()))) (let W3561 (cons V3554 (cons V3555 (cons V3556 ()))) (cons W3561 (cons W3560 ())))))))) (true (simple-error "implementation error in shen.lr-rule")))) - -(defun shen.coll-formulae (V3564) (cond ((= () V3564) ()) ((and (cons? V3564) (and (cons? (hd V3564)) (and (= () (hd (hd V3564))) (and (cons? (tl (hd V3564))) (= () (tl (tl (hd V3564)))))))) (cons (hd (tl (hd V3564))) (shen.coll-formulae (tl V3564)))) (true (simple-error "implementation error in shen.coll-formulae")))) - -(defun shen. (V3565) (let W3566 (if (cons? V3565) (let W3567 (head V3565) (let W3568 (tail V3565) (if (not (shen.key-in-sequent-calculus? W3567)) (shen.comb W3568 (macroexpand W3567)) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W3566) (shen.parse-failure) W3566))) - -(defun shen.key-in-sequent-calculus? (V3569) (or (element? V3569 (cons >> (cons (intern ";") (cons (intern ",") (cons (intern ":") (cons <-- ())))))) (or (shen.sng? V3569) (shen.dbl? V3569)))) - -(defun shen. (V3570) (let W3571 (let W3572 (shen. V3570) (if (shen.parse-failure? W3572) (shen.parse-failure) (let W3573 (shen.<-out W3572) (let W3574 (shen.in-> W3572) (shen.comb W3574 W3573))))) (if (shen.parse-failure? W3571) (shen.parse-failure) W3571))) - -(defun shen. (V3575) (let W3576 (if (cons? V3575) (let W3577 (head V3575) (let W3578 (tail V3575) (if (shen.dbl? W3577) (shen.comb W3578 W3577) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W3576) (shen.parse-failure) W3576))) - -(defun shen. (V3579) (let W3580 (if (cons? V3579) (let W3581 (head V3579) (let W3582 (tail V3579) (if (shen.sng? W3581) (shen.comb W3582 W3581) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W3580) (shen.parse-failure) W3580))) - -(defun shen.sng? (V3583) (and (symbol? V3583) (shen.sng-h? (str V3583)))) - -(defun shen.sng-h? (V3586) (cond ((= "___" V3586) true) ((and (shen.+string? V3586) (= "_" (hdstr V3586))) (shen.sng-h? (tlstr V3586))) (true false))) - -(defun shen.dbl? (V3587) (and (symbol? V3587) (shen.dbl-h? (str V3587)))) - -(defun shen.dbl-h? (V3590) (cond ((= "===" V3590) true) ((and (shen.+string? V3590) (= "=" (hdstr V3590))) (shen.dbl-h? (tlstr V3590))) (true false))) - -(defun shen.rules->prolog (V3591 V3592) (let W3593 (mapcan (lambda Z3594 (shen.rule->clause Z3594)) V3592) (let W3595 (cons defprolog (cons V3591 W3593)) (eval W3595)))) - -(defun shen.rule->clause (V3596) (cond ((and (cons? V3596) (and (cons? (tl V3596)) (and (cons? (tl (tl V3596))) (and (cons? (hd (tl (tl V3596)))) (and (cons? (tl (hd (tl (tl V3596))))) (and (= () (tl (tl (hd (tl (tl V3596)))))) (= () (tl (tl (tl V3596)))))))))) (let W3597 (shen.extract-vars (hd (tl (hd (tl (tl V3596)))))) (append (shen.rule->head (hd (tl (hd (tl (tl V3596)))))) (append (cons <-- ()) (shen.rule->body W3597 Assumptions (hd V3596) (hd (tl V3596)) (hd (hd (tl (tl V3596))))))))) (true (shen.f-error shen.rule->clause)))) - -(defun shen.rule->head (V3598) (cons (shen.macro-@ch V3598) (cons Assumptions ()))) - -(defun shen.macro-@ch (V3599) (cons shen.@ch (cons V3599 ()))) - -(defun shen.macro-@c (V3600) (cons shen.@c (cons V3600 ()))) - -(defun shen.rule->body (V3601 V3602 V3603 V3604 V3605) (cond ((= () V3605) (shen.side-conditions->goals () V3601 V3602 V3603 V3604)) ((and (= () V3604) (and (cons? V3605) (= () (tl V3605)))) (let W3606 (shen.passive-variables (hd V3605) V3601) (let W3607 (shen.remove-bystanders V3601 (hd V3605)) (cons (shen.specialise-member (hd V3605) V3602 W3607 W3606) (shen.side-conditions->goals () V3601 V3602 V3603 ()))))) ((cons? V3605) (let W3608 (gensym NewAssumptions) (let W3609 (shen.passive-variables (hd V3605) V3601) (let W3610 (shen.remove-bystanders V3601 (hd V3605)) (cons (shen.specialise-consume (hd V3605) V3602 W3610 W3609 W3608) (shen.rule->body (append V3601 W3609) W3608 V3603 V3604 (tl V3605))))))) (true (shen.f-error shen.rule->body)))) - -(defun shen.specialise-member (V3611 V3612 V3613 V3614) (let W3615 (gensym shen.member) (let W3616 (shen.member-clause W3615 V3611 V3613 V3614) (cons W3615 (cons V3612 (append V3613 V3614)))))) - -(defun shen.remove-bystanders (V3619 V3620) (cond ((= () V3619) ()) ((and (cons? V3619) (shen.occurs-check? (hd V3619) V3620)) (cons (hd V3619) (shen.remove-bystanders (tl V3619) V3620))) ((cons? V3619) (shen.remove-bystanders (tl V3619) V3620)) (true (shen.f-error shen.remove-bystanders)))) - -(defun shen.member-clause (V3621 V3622 V3623 V3624) (let W3625 (shen.nvars (length V3624)) (let W3626 (append (cons (cons - (cons (cons cons (cons (shen.macro-@ch V3622) (cons _ ()))) ())) ()) (append V3623 (append W3625 (append (cons <-- ()) (append (shen.passive-bind V3624 W3625) (cons (intern ";") ())))))) (let W3627 (let W3628 (gensym Hypotheses) (let W3629 (append V3623 V3624) (let W3630 (append (cons (cons - (cons (cons cons (cons _ (cons W3628 ()))) ())) ()) W3629) (let W3631 (cons (cons V3621 (cons W3628 W3629)) ()) (append W3630 (append (cons <-- ()) (append W3631 (cons (intern ";") ())))))))) (let W3632 (cons defprolog (cons V3621 (append W3626 W3627))) (eval W3632)))))) - -(defun shen.nvars (V3633) (cond ((= 0 V3633) ()) (true (cons (gensym NewV) (shen.nvars (- V3633 1)))))) - -(defun shen.passive-bind (V3634 V3635) (cond ((and (= () V3634) (= () V3635)) ()) ((and (cons? V3634) (cons? V3635)) (cons (cons bind (cons (hd V3635) (cons (hd V3634) ()))) (shen.passive-bind (tl V3634) (tl V3635)))) (true (shen.f-error shen.passive-bind)))) - -(defun shen.specialise-consume (V3636 V3637 V3638 V3639 V3640) (let W3641 (gensym shen.consume) (let W3642 (shen.consume-clause W3641 V3636 V3638 V3639 V3640) (cons W3641 (cons V3637 (cons V3640 (append V3638 V3639))))))) - -(defun shen.consume-clause (V3643 V3644 V3645 V3646 V3647) (let W3648 (shen.nvars (length V3646)) (let W3649 (gensym Assumption) (let W3650 (cons (cons - (cons (cons cons (cons (shen.macro-@ch V3644) (cons W3649 ()))) ())) (cons V3647 (append V3645 (append W3648 (append (cons <-- ()) (append (shen.passive-bind V3646 W3648) (cons (cons bind (cons V3647 (cons W3649 ()))) (cons (intern ";") ())))))))) (let W3651 (let W3652 (gensym Hypotheses) (let W3653 (append V3645 V3646) (let W3654 (gensym Assumptions) (let W3655 (cons (cons - (cons (cons cons (cons W3649 (cons W3652 ()))) ())) (cons (cons cons (cons W3654 (cons V3647 ()))) W3653)) (let W3656 (cons (cons bind (cons W3654 (cons W3649 ()))) (cons (cons V3643 (cons W3652 (cons V3647 W3653))) ())) (append W3655 (append (cons <-- ()) (append W3656 (cons (intern ";") ()))))))))) (let W3657 (cons defprolog (cons V3643 (append W3650 W3651))) (eval W3657))))))) - -(defun shen.passive-variables (V3658 V3659) (difference (shen.extract-vars V3658) V3659)) - -(defun shen.side-conditions->goals (V3662 V3663 V3664 V3665 V3666) (cond ((= () V3665) (shen.premises->goals V3662 V3664 V3666)) ((and (cons? V3665) (and (cons? (hd V3665)) (and (= if (hd (hd V3665))) (and (cons? (tl (hd V3665))) (= () (tl (tl (hd V3665)))))))) (cons (cons when (tl (hd V3665))) (shen.side-conditions->goals V3662 V3663 V3664 (tl V3665) V3666))) ((and (cons? V3665) (and (cons? (hd V3665)) (and (= let (hd (hd V3665))) (and (cons? (tl (hd V3665))) (and (cons? (tl (tl (hd V3665)))) (= () (tl (tl (tl (hd V3665)))))))))) (if (element? (hd (tl (hd V3665))) V3663) (cons (cons is! (tl (hd V3665))) (shen.side-conditions->goals V3662 V3663 V3664 (tl V3665) V3666)) (cons (cons bind (tl (hd V3665))) (shen.side-conditions->goals V3662 (cons (hd (tl (hd V3665))) V3663) V3664 (tl V3665) V3666)))) ((and (cons? V3665) (and (cons? (hd V3665)) (and (= ctxt (hd (hd V3665))) (and (cons? (tl (hd V3665))) (= () (tl (tl (hd V3665)))))))) (if (element? (hd (tl (hd V3665))) V3663) (shen.side-conditions->goals (cons (hd (tl (hd V3665))) V3662) V3663 V3664 (tl V3665) V3666) (cons (cons bind (cons (hd (tl (hd V3665))) (cons V3664 ()))) (shen.side-conditions->goals (cons (hd (tl (hd V3665))) V3662) (cons (hd (tl (hd V3665))) V3663) (hd (tl (hd V3665))) (tl V3665) V3666)))) (true (shen.f-error shen.side-conditions->goals)))) - -(defun shen.premises->goals (V3671 V3672 V3673) (cond ((= () V3673) (cons (intern ";") ())) ((and (cons? V3673) (= ! (hd V3673))) (cons ! (shen.premises->goals V3671 V3672 (tl V3673)))) ((and (cons? V3673) (= fail (hd V3673))) (cons (cons when (cons false ())) (shen.premises->goals V3671 V3672 (tl V3673)))) ((and (cons? V3673) (and (cons? (hd V3673)) (and (cons? (tl (hd V3673))) (= () (tl (tl (hd V3673))))))) (cons (cons shen.system-S (cons (shen.macro-@c (hd (tl (hd V3673)))) (cons (shen.construct-context V3671 (hd (hd V3673)) V3672) ()))) (shen.premises->goals V3671 V3672 (tl V3673)))) (true (shen.f-error shen.premises->goals)))) - -(defun shen.construct-context (V3677 V3678 V3679) (cond ((= () V3678) V3679) ((and (cons? V3678) (and (= () (tl V3678)) (element? (hd V3678) V3677))) (hd V3678)) ((cons? V3678) (cons cons (cons (shen.macro-@c (hd V3678)) (cons (shen.construct-context V3677 (tl V3678) V3679) ())))) (true (shen.f-error shen.construct-context)))) - -(defun compile (V112 V113) (let W114 (V112 V113) (if (shen.parse-failure? W114) (simple-error "parse failure -") (if (shen.partial-parse-failure? W114) (do (set shen.*residue* (shen.in-> W114)) (shen.raise-syntax-error (value shen.*residue*))) (shen.<-out W114))))) - -(defun shen.raise-syntax-error (V115) (simple-error (shen.proc-nl (cn "syntax error here: " (shen.syntax-error-message (value *maximum-print-sequence-size*) 0 V115))))) - -(defun shen.syntax-error-message (V123 V124 V125) (cond ((= () V125) " -") ((= V123 V124) "...etc -") ((cons? V125) (cn (shen.app (hd V125) " " shen.s) (shen.syntax-error-message V123 (+ V124 1) (tl V125)))) (true (shen.f-error shen.syntax-error-message)))) - -(defun shen.parse-failure? (V126) (= V126 (fail))) - -(defun shen.partial-parse-failure? (V127) (cons? (shen.in-> V127))) - -(defun shen.yacc->shen (V131) (compile (lambda Z132 (shen. Z132)) V131)) - -(defun shen. (V133) (let W134 (if (cons? V133) (let W135 (head V133) (let W136 (tail V133) (let W137 (shen. W136) (if (shen.parse-failure? W137) (shen.parse-failure) (let W138 (shen.<-out W137) (let W139 (shen.in-> W137) (let W140 (shen. W139) (if (shen.parse-failure? W140) (shen.parse-failure) (let W141 (shen.<-out W140) (let W142 (shen.in-> W140) (shen.comb W142 (let W143 (gensym S) (let W144 (append (cons define (cons W135 ())) (append W138 (cons W143 (cons -> (cons (shen.c-rules->shen W138 W143 W141) ()))))) W144))))))))))))) (shen.parse-failure)) (if (shen.parse-failure? W134) (shen.parse-failure) W134))) - -(defun shen. (V145) (let W146 (if (cons? V145) (let W147 (head V145) (let W148 (tail V145) (if (shen.ccons? W148) (let W149 (head W148) (let W150 (tail W148) (if (shen.hds=? W149 list) (let W151 (tail W149) (if (cons? W151) (let W152 (head W151) (let W153 (tail W151) (let W154 ( W153) (if (shen.parse-failure? W154) (shen.parse-failure) (let W155 (shen.in-> W154) (if (shen.hds=? W150 ==>) (let W156 (tail W150) (if (cons? W156) (let W157 (head W156) (let W158 (tail W156) (if (cons? W158) (let W159 (head W158) (let W160 (tail W158) (if (and (= { W147) (= } W159)) (shen.comb W160 (cons { (cons (cons list (cons W152 ())) (cons --> (cons (cons str (cons (cons list (cons W152 ())) (cons W157 ()))) (cons } ())))))) (shen.parse-failure)))) (shen.parse-failure)))) (shen.parse-failure))) (shen.parse-failure))))))) (shen.parse-failure))) (shen.parse-failure)))) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W146) (let W161 (let W162 ( V145) (if (shen.parse-failure? W162) (shen.parse-failure) (let W163 (shen.in-> W162) (shen.comb W163 ())))) (if (shen.parse-failure? W161) (shen.parse-failure) W161)) W146))) - -(defun shen. (V164) (let W165 (let W166 (shen. V164) (if (shen.parse-failure? W166) (shen.parse-failure) (let W167 (shen.<-out W166) (let W168 (shen.in-> W166) (let W169 (shen. W168) (if (shen.parse-failure? W169) (shen.parse-failure) (let W170 (shen.<-out W169) (let W171 (shen.in-> W169) (shen.comb W171 (cons W167 W170)))))))))) (if (shen.parse-failure? W165) (let W172 (let W173 ( V164) (if (shen.parse-failure? W173) (shen.parse-failure) (let W174 (shen.<-out W173) (let W175 (shen.in-> W173) (shen.comb W175 (if (empty? W174) () (simple-error (cn "YACC syntax error here: - " (shen.app W174 " - ..." shen.r))))))))) (if (shen.parse-failure? W172) (shen.parse-failure) W172)) W165))) - -(defun shen. (V176) (let W177 (let W178 (shen. V176) (if (shen.parse-failure? W178) (shen.parse-failure) (let W179 (shen.<-out W178) (let W180 (shen.in-> W178) (let W181 (shen. W180) (if (shen.parse-failure? W181) (shen.parse-failure) (let W182 (shen.<-out W181) (let W183 (shen.in-> W181) (let W184 (shen. W183) (if (shen.parse-failure? W184) (shen.parse-failure) (let W185 (shen.in-> W184) (shen.comb W185 (cons W179 (cons W182 ())))))))))))))) (if (shen.parse-failure? W177) (let W186 (let W187 (shen. V176) (if (shen.parse-failure? W187) (shen.parse-failure) (let W188 (shen.<-out W187) (let W189 (shen.in-> W187) (let W190 (shen. W189) (if (shen.parse-failure? W190) (shen.parse-failure) (let W191 (shen.in-> W190) (shen.comb W191 (cons W188 (cons (shen.autocomplete W188) ())))))))))) (if (shen.parse-failure? W186) (shen.parse-failure) W186)) W177))) - -(defun shen.autocomplete (V192) (cond ((and (cons? V192) (and (= () (tl V192)) (shen.non-terminal? (hd V192)))) (hd V192)) ((and (cons? V192) (shen.non-terminal? (hd V192))) (cons append (cons (hd V192) (cons (shen.autocomplete (tl V192)) ())))) ((cons? V192) (cons cons (cons (shen.autocomplete (hd V192)) (cons (shen.autocomplete (tl V192)) ())))) (true V192))) - -(defun shen.non-terminal? (V193) (and (symbol? V193) (let W194 (explode V193) (compile (lambda Z195 (shen. Z195)) W194)))) - -(defun shen. (V196) (let W197 (let W198 (shen. V196) (if (shen.parse-failure? W198) (shen.parse-failure) (let W199 (shen.in-> W198) (let W200 (shen. W199) (if (shen.parse-failure? W200) (shen.parse-failure) (let W201 (shen.in-> W200) (shen.comb W201 true))))))) (if (shen.parse-failure? W197) (let W202 (let W203 (shen. V196) (if (shen.parse-failure? W203) (shen.parse-failure) (let W204 (shen.in-> W203) (shen.comb W204 true)))) (if (shen.parse-failure? W202) (let W205 (let W206 ( V196) (if (shen.parse-failure? W206) (shen.parse-failure) (let W207 (shen.in-> W206) (shen.comb W207 false)))) (if (shen.parse-failure? W205) (shen.parse-failure) W205)) W202)) W197))) - -(defun shen. (V208) (let W209 (let W210 (shen. V208) (if (shen.parse-failure? W210) (shen.parse-failure) (let W211 (shen.in-> W210) (if (shen.hds=? W211 ".") (let W212 (tail W211) (let W213 (shen. W212) (if (shen.parse-failure? W213) (shen.parse-failure) (let W214 (shen.in-> W213) (shen.comb W214 shen.skip))))) (shen.parse-failure))))) (if (shen.parse-failure? W209) (let W215 (let W216 (shen. V208) (if (shen.parse-failure? W216) (shen.parse-failure) (let W217 (shen.in-> W216) (if (shen.hds=? W217 ".") (let W218 (tail W217) (shen.comb W218 shen.skip)) (shen.parse-failure))))) (if (shen.parse-failure? W215) (shen.parse-failure) W215)) W209))) - -(defun shen. (V219) (let W220 (let W221 (shen. V219) (if (shen.parse-failure? W221) (shen.parse-failure) (let W222 (shen.in-> W221) (let W223 (shen. W222) (if (shen.parse-failure? W223) (shen.parse-failure) (let W224 (shen.in-> W223) (shen.comb W224 shen.skip))))))) (if (shen.parse-failure? W220) (let W225 (let W226 ( V219) (if (shen.parse-failure? W226) (shen.parse-failure) (let W227 (shen.in-> W226) (shen.comb W227 shen.skip)))) (if (shen.parse-failure? W225) (shen.parse-failure) W225)) W220))) - -(defun shen. (V228) (let W229 (if (cons? V228) (let W230 (head V228) (let W231 (tail V228) (if (not (= W230 ".")) (shen.comb W231 shen.skip) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W229) (shen.parse-failure) W229))) - -(defun shen. (V232) (let W233 (if (shen.hds=? V232 "<") (let W234 (tail V232) (let W235 ( W234) (if (shen.parse-failure? W235) (shen.parse-failure) (let W236 (shen.<-out W235) (let W237 (shen.in-> W235) (if (let W238 (reverse W236) (and (cons? W238) (= (hd W238) ">"))) (shen.comb W237 shen.skip) (shen.parse-failure))))))) (shen.parse-failure)) (if (shen.parse-failure? W233) (shen.parse-failure) W233))) - -(defun shen.semicolon? (V239) (= V239 (intern ";"))) - -(defun shen. (V240) (let W241 (if (cons? V240) (let W242 (head V240) (let W243 (tail V240) (if (shen.colon-equal? W242) (shen.comb W243 shen.skip) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W241) (shen.parse-failure) W241))) - -(defun shen.colon-equal? (V244) (= (intern ":=") V244)) - -(defun shen. (V245) (let W246 (let W247 (shen. V245) (if (shen.parse-failure? W247) (shen.parse-failure) (let W248 (shen.<-out W247) (let W249 (shen.in-> W247) (let W250 (shen. W249) (if (shen.parse-failure? W250) (shen.parse-failure) (let W251 (shen.<-out W250) (let W252 (shen.in-> W250) (shen.comb W252 (cons W248 W251)))))))))) (if (shen.parse-failure? W246) (let W253 (let W254 (shen. V245) (if (shen.parse-failure? W254) (shen.parse-failure) (let W255 (shen.<-out W254) (let W256 (shen.in-> W254) (shen.comb W256 (cons W255 ())))))) (if (shen.parse-failure? W253) (shen.parse-failure) W253)) W246))) - -(defun shen. (V257) (let W258 (if (cons? V257) (let W259 (head V257) (let W260 (tail V257) (if (shen.syntax-item? W259) (shen.comb W260 W259) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W258) (shen.parse-failure) W258))) - -(defun shen.syntax-item? (V263) (cond ((shen.colon-equal? V263) false) ((shen.semicolon? V263) false) ((atom? V263) true) ((and (cons? V263) (and (= cons (hd V263)) (and (cons? (tl V263)) (and (cons? (tl (tl V263))) (= () (tl (tl (tl V263)))))))) (and (shen.syntax-item? (hd (tl V263))) (shen.syntax-item? (hd (tl (tl V263)))))) (true false))) - -(defun shen. (V264) (let W265 (let W266 (shen. V264) (if (shen.parse-failure? W266) (shen.parse-failure) (let W267 (shen.in-> W266) (if (cons? W267) (let W268 (head W267) (let W269 (tail W267) (if (shen.hds=? W269 where) (let W270 (tail W269) (if (cons? W270) (let W271 (head W270) (let W272 (tail W270) (if (not (shen.semicolon? W268)) (shen.comb W272 (cons where (cons W271 (cons W268 ())))) (shen.parse-failure)))) (shen.parse-failure))) (shen.parse-failure)))) (shen.parse-failure))))) (if (shen.parse-failure? W265) (let W273 (let W274 (shen. V264) (if (shen.parse-failure? W274) (shen.parse-failure) (let W275 (shen.in-> W274) (if (cons? W275) (let W276 (head W275) (let W277 (tail W275) (if (not (shen.semicolon? W276)) (shen.comb W277 W276) (shen.parse-failure)))) (shen.parse-failure))))) (if (shen.parse-failure? W273) (shen.parse-failure) W273)) W265))) - -(defun shen.c-rules->shen (V286 V287 V288) (cond ((= () V288) (cons shen.parse-failure ())) ((cons? V288) (shen.combine-c-code (shen.c-rule->shen V286 (hd V288) V287) (shen.c-rules->shen V286 V287 (tl V288)))) (true (simple-error "implementation error in shen.c-rules->shen -")))) - -(defun shen.parse-failure () (fail)) - -(defun shen.combine-c-code (V289 V290) (cons let (cons Result (cons V289 (cons (cons if (cons (cons shen.parse-failure? (cons Result ())) (cons V290 (cons Result ())))) ()))))) - -(defun shen.c-rule->shen (V297 V298 V299) (cond ((and (cons? V298) (and (cons? (tl V298)) (= () (tl (tl V298))))) (shen.yacc-syntax V297 V299 (hd V298) (hd (tl V298)))) (true (simple-error "implementation error in shen.c-rule->shen -")))) - -(defun shen.yacc-syntax (V308 V309 V310 V311) (cond ((and (= () V310) (and (cons? V311) (and (= where (hd V311)) (and (cons? (tl V311)) (and (cons? (tl (tl V311))) (= () (tl (tl (tl V311))))))))) (cons if (cons (shen.process-yacc-semantics (hd (tl V311))) (cons (shen.yacc-syntax V308 V309 () (hd (tl (tl V311)))) (cons (cons shen.parse-failure ()) ()))))) ((= () V310) (shen.yacc-semantics V308 V309 V311)) ((cons? V310) (if (shen.non-terminal? (hd V310)) (shen.non-terminalcode V308 V309 (hd V310) (tl V310) V311) (if (variable? (hd V310)) (shen.variablecode V308 V309 (hd V310) (tl V310) V311) (if (= _ (hd V310)) (shen.wildcardcode V308 V309 (hd V310) (tl V310) V311) (if (atom? (hd V310)) (shen.terminalcode V308 V309 (hd V310) (tl V310) V311) (if (cons? (hd V310)) (shen.conscode V308 V309 (hd V310) (tl V310) V311) (simple-error "implementation error in shen.yacc-syntax -"))))))) (true (simple-error "implementation error in shen.yacc-syntax -")))) - -(defun shen.non-terminalcode (V312 V313 V314 V315 V316) (let W317 (concat Parse V314) (let W318 (concat Action V314) (let W319 (concat Remainder V314) (cons let (cons W317 (cons (cons V314 (cons V313 ())) (cons (cons if (cons (cons shen.parse-failure? (cons W317 ())) (cons (cons shen.parse-failure ()) (cons (let W320 (cons let (cons W319 (cons (cons shen.in-> (cons W317 ())) (cons (shen.yacc-syntax V312 W319 V315 V316) ())))) (if (or (shen.occurs-check? V314 V316) (shen.occurs-check? W318 V316)) (cons let (cons W318 (cons (cons shen.<-out (cons W317 ())) (cons W320 ())))) W320)) ())))) ())))))))) - -(defun shen.variablecode (V321 V322 V323 V324 V325) (let W326 (gensym Remainder) (cons if (cons (cons cons? (cons V322 ())) (cons (let W327 (cons let (cons W326 (cons (cons tail (cons V322 ())) (cons (shen.yacc-syntax V321 W326 V324 V325) ())))) (if (shen.occurs-check? V323 V325) (cons let (cons V323 (cons (cons head (cons V322 ())) (cons W327 ())))) W327)) (cons (cons shen.parse-failure ()) ())))))) - -(defun shen.wildcardcode (V328 V329 V330 V331 V332) (let W333 (gensym Remainder) (cons if (cons (cons cons? (cons V329 ())) (cons (cons let (cons W333 (cons (cons tail (cons V329 ())) (cons (shen.yacc-syntax V328 W333 V331 V332) ())))) (cons (cons shen.parse-failure ()) ())))))) - -(defun shen.terminalcode (V334 V335 V336 V337 V338) (let W339 (gensym Remainder) (cons if (cons (cons shen.hds=? (cons V335 (cons V336 ()))) (cons (cons let (cons W339 (cons (cons tail (cons V335 ())) (cons (shen.yacc-syntax V334 W339 V337 V338) ())))) (cons (cons shen.parse-failure ()) ())))))) - -(defun shen.hds=? (V347 V348) (cond ((and (cons? V347) (= (hd V347) V348)) true) (true false))) - -(defun shen.conscode (V349 V350 V351 V352 V353) (let W354 (gensym Remainder) (let W355 (gensym Hd) (let W356 (gensym Tl) (cons if (cons (cons shen.ccons? (cons V350 ())) (cons (cons let (cons W355 (cons (cons head (cons V350 ())) (cons W356 (cons (cons tail (cons V350 ())) (cons (shen.yacc-syntax V349 W355 (append (shen.decons V351) (cons ())) (cons shen.processed (cons (shen.yacc-syntax V349 W356 V352 V353) ()))) ())))))) (cons (cons shen.parse-failure ()) ())))))))) - -(defun shen.ccons? (V365) (cond ((and (cons? V365) (cons? (hd V365))) true) (true false))) - -(defun shen.decons (V366) (cond ((and (cons? V366) (and (= cons (hd V366)) (and (cons? (tl V366)) (and (cons? (tl (tl V366))) (= () (tl (tl (tl V366)))))))) (cons (hd (tl V366)) (shen.decons (hd (tl (tl V366)))))) (true V366))) - -(defun shen.comb (V367 V368) (cons V367 (cons V368 ()))) - -(defun shen.yacc-semantics (V373 V374 V375) (cond ((and (cons? V375) (and (= shen.processed (hd V375)) (and (cons? (tl V375)) (= () (tl (tl V375)))))) (hd (tl V375))) (true (let W376 (shen.process-yacc-semantics V375) (let W377 (shen.use-type-info V373 W376) (cons shen.comb (cons V374 (cons W377 ())))))))) - -(defun shen.use-type-info (V381 V382) (cond ((and (cons? V381) (and (= { (hd V381)) (and (cons? (tl V381)) (and (cons? (hd (tl V381))) (and (= list (hd (hd (tl V381)))) (and (cons? (tl (hd (tl V381)))) (and (= () (tl (tl (hd (tl V381))))) (and (cons? (tl (tl V381))) (and (= --> (hd (tl (tl V381)))) (and (cons? (tl (tl (tl V381)))) (and (cons? (hd (tl (tl (tl V381))))) (and (= str (hd (hd (tl (tl (tl V381)))))) (and (cons? (tl (hd (tl (tl (tl V381)))))) (and (cons? (hd (tl (hd (tl (tl (tl V381))))))) (and (= list (hd (hd (tl (hd (tl (tl (tl V381)))))))) (and (cons? (tl (hd (tl (hd (tl (tl (tl V381)))))))) (and (= () (tl (tl (hd (tl (hd (tl (tl (tl V381))))))))) (and (cons? (tl (tl (hd (tl (tl (tl V381))))))) (and (= () (tl (tl (tl (hd (tl (tl (tl V381)))))))) (and (cons? (tl (tl (tl (tl V381))))) (and (= } (hd (tl (tl (tl (tl V381)))))) (and (= () (tl (tl (tl (tl (tl V381)))))) (and (= (hd (tl (hd (tl V381)))) (hd (tl (hd (tl (hd (tl (tl (tl V381))))))))) (shen.monomorphic? (hd (tl (tl (hd (tl (tl (tl V381))))))))))))))))))))))))))))))) (cons type (cons V382 (tl (tl (hd (tl (tl (tl V381))))))))) (true V382))) - -(defun shen.monomorphic? (V385) (cond ((variable? V385) false) ((cons? V385) (and (shen.monomorphic? (hd V385)) (shen.monomorphic? (tl V385)))) (true true))) - -(defun shen.process-yacc-semantics (V386) (cond ((and (cons? V386) (and (= protect (hd V386)) (and (cons? (tl V386)) (and (= () (tl (tl V386))) (shen.non-terminal? (hd (tl V386))))))) (hd (tl V386))) ((cons? V386) (map (lambda Z387 (shen.process-yacc-semantics Z387)) V386)) ((shen.non-terminal? V386) (concat Action V386)) (true V386))) - -(defun shen.<-out (V390) (cond ((and (cons? V390) (and (cons? (tl V390)) (= () (tl (tl V390))))) (hd (tl V390))) (true (hd (tl V390))))) - -(defun shen.in-> (V391) (hd V391)) - -(defun (V392) (cons () (cons V392 ()))) - -(defun (V393) (cons V393 (cons () ()))) - -(defun (V396) (cond ((= () V396) (cons () (cons () ()))) (true (shen.parse-failure)))) - -(defun read-file (V2528) (let W2529 (read-file-as-bytelist V2528) (let W2530 (trap-error (compile (lambda Z2531 (shen. Z2531)) W2529) (lambda Z2532 (shen.reader-error (value shen.*residue*)))) (let W2533 (shen.process-sexprs W2530) W2533)))) - -(defun shen.reader-error (V2534) (simple-error (shen.proc-nl (cn "reader error near here: " (shen.reader-error-message (value *maximum-print-sequence-size*) 0 V2534))))) - -(defun shen.reader-error-message (V2542 V2543 V2544) (cond ((= () V2544) "") ((= V2542 V2543) "") ((cons? V2544) (cn (n->string (hd V2544)) (shen.reader-error-message V2542 (+ V2543 1) (tl V2544)))) (true (shen.f-error shen.reader-error-message)))) - -(defun read-file-as-bytelist (V2545) (let W2546 (open V2545 in) (let W2547 (read-byte W2546) (let W2548 (shen.read-file-as-bytelist-help W2546 W2547 ()) (let W2549 (close W2546) (reverse W2548)))))) - -(defun shen.read-file-as-bytelist-help (V2550 V2551 V2552) (cond ((= -1 V2551) V2552) (true (shen.read-file-as-bytelist-help V2550 (read-byte V2550) (cons V2551 V2552))))) - -(defun input (V2558) (eval-kl (read V2558))) - -(defun input+ (V2559 V2560) (let W2561 (shen.monotype V2559) (let W2562 (read V2560) (if (= false (shen.typecheck W2562 (shen.rectify-type V2559))) (simple-error (cn "type error: " (shen.app W2562 (cn " is not of type " (shen.app V2559 " -" shen.r)) shen.r))) (eval-kl W2562))))) - -(defun shen.monotype (V2563) (cond ((cons? V2563) (map (lambda Z2564 (shen.monotype Z2564)) V2563)) (true (if (variable? V2563) (simple-error (cn "input+ expects a monotype: not " (shen.app V2563 " -" shen.a))) V2563)))) - -(defun lineread (V2565) (shen.read-loop V2565 (shen.my-read-byte V2565) () (lambda Z2566 (shen.return? Z2566)))) - -(defun read (V2577) (hd (shen.read-loop V2577 (shen.my-read-byte V2577) () (lambda Z2578 (shen.whitespace? Z2578))))) - -(defun shen.my-read-byte (V2579) (if (shen.char-stinput? V2579) (string->n (shen.read-unit-string V2579)) (read-byte V2579))) - -(defun shen.read-loop (V2584 V2585 V2586 V2587) (cond ((= 94 V2585) (simple-error "read aborted")) ((= -1 V2585) (if (empty? V2586) (simple-error "error: empty stream") (compile (lambda Z2588 (shen. Z2588)) V2586))) ((= 0 V2585) (shen.read-loop V2584 (shen.my-read-byte V2584) V2586 V2587)) (true (if (V2587 V2585) (let W2589 (shen.try-parse V2586) (if (shen.nothing-doing? W2589) (shen.read-loop V2584 (shen.my-read-byte V2584) (append V2586 (cons V2585 ())) V2587) (do (shen.record-it V2586) W2589))) (shen.read-loop V2584 (shen.my-read-byte V2584) (append V2586 (cons V2585 ())) V2587))))) - -(defun shen.try-parse (V2590) (let W2591 (trap-error (compile (lambda Z2592 (shen. Z2592)) V2590) (lambda Z2593 shen.i-failed!)) (if (shen.nothing-doing? W2591) shen.i-failed! (shen.process-sexprs W2591)))) - -(defun shen.nothing-doing? (V2596) (cond ((= shen.i-failed! V2596) true) ((= () V2596) true) (true false))) - -(defun shen.record-it (V2597) (set shen.*it* (shen.bytes->string V2597))) - -(defun shen.bytes->string (V2598) (cond ((= () V2598) "") ((cons? V2598) (cn (n->string (hd V2598)) (shen.bytes->string (tl V2598)))) (true (shen.f-error shen.bytes->string)))) - -(defun shen.process-sexprs (V2599) (let W2600 (shen.unpackage¯oexpand V2599) (let W2601 (shen.find-arities W2600) (let W2602 (shen.find-types W2600) (map (lambda Z2603 (shen.process-applications Z2603 W2602)) W2600))))) - -(defun shen.find-types (V2604) (cond ((and (cons? V2604) (and (cons? (tl V2604)) (= (hd V2604) (intern ":")))) (cons (hd (tl V2604)) (shen.find-types (tl (tl V2604))))) ((cons? V2604) (append (shen.find-types (hd V2604)) (shen.find-types (tl V2604)))) (true ()))) - -(defun shen.find-arities (V2607) (cond ((and (cons? V2607) (and (= define (hd V2607)) (and (cons? (tl V2607)) (and (cons? (tl (tl V2607))) (= { (hd (tl (tl V2607)))))))) (shen.store-arity (hd (tl V2607)) (shen.find-arity (hd (tl V2607)) 1 (tl (tl (tl V2607)))))) ((and (cons? V2607) (and (= define (hd V2607)) (cons? (tl V2607)))) (shen.store-arity (hd (tl V2607)) (shen.find-arity (hd (tl V2607)) 0 (tl (tl V2607))))) ((cons? V2607) (map (lambda Z2608 (shen.find-arities Z2608)) V2607)) (true shen.skip))) - -(defun shen.store-arity (V2609 V2610) (let W2611 (arity V2609) (if (= W2611 -1) (shen.execute-store-arity V2609 V2610) (if (= W2611 V2610) shen.skip (if (shen.sysfunc? V2609) (simple-error (shen.app V2609 " is a system function -" shen.a)) (do (pr (cn "changing the arity of " (shen.app V2609 " may cause errors -" shen.a)) (stoutput)) (shen.execute-store-arity V2609 V2610))))))) - -(defun shen.execute-store-arity (V2612 V2613) (cond ((= 0 V2613) (put V2612 arity 0 (value *property-vector*))) (true (do (put V2612 arity V2613 (value *property-vector*)) (shen.update-lambdatable V2612 V2613))))) - -(defun shen.update-lambdatable (V2614 V2615) (let W2616 (eval-kl (shen.lambda-function (cons V2614 ()) V2615)) (let W2617 (shen.set-lambda-form-entry (cons V2614 W2616)) V2615))) - -(defun shen.lambda-function (V2620 V2621) (cond ((= 0 V2621) shen.skip) ((= 1 V2621) (let W2622 (gensym Y) (cons lambda (cons W2622 (cons (append V2620 (cons W2622 ())) ()))))) (true (let W2623 (gensym Y) (cons lambda (cons W2623 (cons (shen.lambda-function (append V2620 (cons W2623 ())) (- V2621 1)) ()))))))) - -(defun shen.assoc-> (V2633 V2634 V2635) (cond ((= () V2635) (cons (cons V2633 V2634) ())) ((and (cons? V2635) (and (cons? (hd V2635)) (= V2633 (hd (hd V2635))))) (cons (cons (hd (hd V2635)) V2634) (tl V2635))) ((cons? V2635) (cons (hd V2635) (shen.assoc-> V2633 V2634 (tl V2635)))) (true (simple-error "implementation error in shen.assoc->")))) - -(defun shen.find-arity (V2650 V2651 V2652) (cond ((and (= 0 V2651) (and (cons? V2652) (= (hd V2652) ->))) 0) ((and (= 0 V2651) (and (cons? V2652) (= (hd V2652) <-))) 0) ((and (= 0 V2651) (cons? V2652)) (+ 1 (shen.find-arity V2650 0 (tl V2652)))) ((and (= 1 V2651) (and (cons? V2652) (= } (hd V2652)))) (shen.find-arity V2650 0 (tl V2652))) ((and (= 1 V2651) (cons? V2652)) (shen.find-arity V2650 1 (tl V2652))) ((= 1 V2651) (simple-error (cn "syntax error in " (shen.app V2650 " definition: missing } -" shen.a)))) (true (simple-error (cn "syntax error in " (shen.app V2650 " definition: missing -> or <- -" shen.a)))))) - -(defun shen. (V2653) (let W2654 (let W2655 (shen. V2653) (if (shen.parse-failure? W2655) (shen.parse-failure) (let W2656 (shen.in-> W2655) (let W2657 (shen. W2656) (if (shen.parse-failure? W2657) (shen.parse-failure) (let W2658 (shen.<-out W2657) (let W2659 (shen.in-> W2657) (let W2660 (shen. W2659) (if (shen.parse-failure? W2660) (shen.parse-failure) (let W2661 (shen.in-> W2660) (let W2662 (shen. W2661) (if (shen.parse-failure? W2662) (shen.parse-failure) (let W2663 (shen.<-out W2662) (let W2664 (shen.in-> W2662) (shen.comb W2664 (cons (shen.cons-form W2658) W2663)))))))))))))))) (if (shen.parse-failure? W2654) (let W2665 (let W2666 (shen. V2653) (if (shen.parse-failure? W2666) (shen.parse-failure) (let W2667 (shen.in-> W2666) (let W2668 (shen. W2667) (if (shen.parse-failure? W2668) (shen.parse-failure) (let W2669 (shen.<-out W2668) (let W2670 (shen.in-> W2668) (let W2671 (shen. W2670) (if (shen.parse-failure? W2671) (shen.parse-failure) (let W2672 (shen.in-> W2671) (let W2673 (shen. W2672) (if (shen.parse-failure? W2673) (shen.parse-failure) (let W2674 (shen.<-out W2673) (let W2675 (shen.in-> W2673) (shen.comb W2675 (shen.add-sexpr W2669 W2674)))))))))))))))) (if (shen.parse-failure? W2665) (let W2676 (let W2677 (shen. V2653) (if (shen.parse-failure? W2677) (shen.parse-failure) (let W2678 (shen.in-> W2677) (let W2679 (shen. W2678) (if (shen.parse-failure? W2679) (shen.parse-failure) (let W2680 (shen.<-out W2679) (let W2681 (shen.in-> W2679) (shen.comb W2681 (cons { W2680))))))))) (if (shen.parse-failure? W2676) (let W2682 (let W2683 (shen. V2653) (if (shen.parse-failure? W2683) (shen.parse-failure) (let W2684 (shen.in-> W2683) (let W2685 (shen. W2684) (if (shen.parse-failure? W2685) (shen.parse-failure) (let W2686 (shen.<-out W2685) (let W2687 (shen.in-> W2685) (shen.comb W2687 (cons } W2686))))))))) (if (shen.parse-failure? W2682) (let W2688 (let W2689 (shen. V2653) (if (shen.parse-failure? W2689) (shen.parse-failure) (let W2690 (shen.in-> W2689) (let W2691 (shen. W2690) (if (shen.parse-failure? W2691) (shen.parse-failure) (let W2692 (shen.<-out W2691) (let W2693 (shen.in-> W2691) (shen.comb W2693 (cons bar! W2692))))))))) (if (shen.parse-failure? W2688) (let W2694 (let W2695 (shen. V2653) (if (shen.parse-failure? W2695) (shen.parse-failure) (let W2696 (shen.in-> W2695) (let W2697 (shen. W2696) (if (shen.parse-failure? W2697) (shen.parse-failure) (let W2698 (shen.<-out W2697) (let W2699 (shen.in-> W2697) (shen.comb W2699 (cons (intern ";") W2698))))))))) (if (shen.parse-failure? W2694) (let W2700 (let W2701 (shen. V2653) (if (shen.parse-failure? W2701) (shen.parse-failure) (let W2702 (shen.in-> W2701) (let W2703 (shen. W2702) (if (shen.parse-failure? W2703) (shen.parse-failure) (let W2704 (shen.in-> W2703) (let W2705 (shen. W2704) (if (shen.parse-failure? W2705) (shen.parse-failure) (let W2706 (shen.<-out W2705) (let W2707 (shen.in-> W2705) (shen.comb W2707 (cons (intern ":=") W2706)))))))))))) (if (shen.parse-failure? W2700) (let W2708 (let W2709 (shen. V2653) (if (shen.parse-failure? W2709) (shen.parse-failure) (let W2710 (shen.in-> W2709) (let W2711 (shen. W2710) (if (shen.parse-failure? W2711) (shen.parse-failure) (let W2712 (shen.<-out W2711) (let W2713 (shen.in-> W2711) (shen.comb W2713 (cons (intern ":") W2712))))))))) (if (shen.parse-failure? W2708) (let W2714 (let W2715 (shen. V2653) (if (shen.parse-failure? W2715) (shen.parse-failure) (let W2716 (shen.in-> W2715) (let W2717 (shen. W2716) (if (shen.parse-failure? W2717) (shen.parse-failure) (let W2718 (shen.<-out W2717) (let W2719 (shen.in-> W2717) (shen.comb W2719 (cons (intern ",") W2718))))))))) (if (shen.parse-failure? W2714) (let W2720 (let W2721 (shen. V2653) (if (shen.parse-failure? W2721) (shen.parse-failure) (let W2722 (shen.in-> W2721) (let W2723 (shen. W2722) (if (shen.parse-failure? W2723) (shen.parse-failure) (let W2724 (shen.<-out W2723) (let W2725 (shen.in-> W2723) (shen.comb W2725 W2724)))))))) (if (shen.parse-failure? W2720) (let W2726 (let W2727 (shen. V2653) (if (shen.parse-failure? W2727) (shen.parse-failure) (let W2728 (shen.<-out W2727) (let W2729 (shen.in-> W2727) (let W2730 (shen. W2729) (if (shen.parse-failure? W2730) (shen.parse-failure) (let W2731 (shen.<-out W2730) (let W2732 (shen.in-> W2730) (shen.comb W2732 (cons W2728 W2731)))))))))) (if (shen.parse-failure? W2726) (let W2733 (let W2734 (shen. V2653) (if (shen.parse-failure? W2734) (shen.parse-failure) (let W2735 (shen.in-> W2734) (let W2736 (shen. W2735) (if (shen.parse-failure? W2736) (shen.parse-failure) (let W2737 (shen.<-out W2736) (let W2738 (shen.in-> W2736) (shen.comb W2738 W2737)))))))) (if (shen.parse-failure? W2733) (let W2739 (let W2740 ( V2653) (if (shen.parse-failure? W2740) (shen.parse-failure) (let W2741 (shen.in-> W2740) (shen.comb W2741 ())))) (if (shen.parse-failure? W2739) (shen.parse-failure) W2739)) W2733)) W2726)) W2720)) W2714)) W2708)) W2700)) W2694)) W2688)) W2682)) W2676)) W2665)) W2654))) - -(defun shen.add-sexpr (V2742 V2743) (cond ((and (cons? V2742) (and (= $ (hd V2742)) (and (cons? (tl V2742)) (= () (tl (tl V2742)))))) (append (explode (hd (tl V2742))) V2743)) (true (cons V2742 V2743)))) - -(defun shen. (V2744) (let W2745 (if (shen.hds=? V2744 91) (let W2746 (tail V2744) (shen.comb W2746 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2745) (shen.parse-failure) W2745))) - -(defun shen. (V2747) (let W2748 (if (shen.hds=? V2747 93) (let W2749 (tail V2747) (shen.comb W2749 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2748) (shen.parse-failure) W2748))) - -(defun shen. (V2750) (let W2751 (let W2752 (shen. V2750) (if (shen.parse-failure? W2752) (shen.parse-failure) (let W2753 (shen.<-out W2752) (let W2754 (shen.in-> W2752) (shen.comb W2754 W2753))))) (if (shen.parse-failure? W2751) (shen.parse-failure) W2751))) - -(defun shen. (V2755) (let W2756 (let W2757 (shen. V2755) (if (shen.parse-failure? W2757) (shen.parse-failure) (let W2758 (shen.<-out W2757) (let W2759 (shen.in-> W2757) (shen.comb W2759 W2758))))) (if (shen.parse-failure? W2756) (shen.parse-failure) W2756))) - -(defun shen.cons-form (V2761) (cond ((= () V2761) ()) ((and (cons? V2761) (and (cons? (tl V2761)) (and (cons? (tl (tl V2761))) (and (= () (tl (tl (tl V2761)))) (= (hd (tl V2761)) bar!))))) (cons cons (cons (hd V2761) (tl (tl V2761))))) ((and (cons? V2761) (and (cons? (tl V2761)) (and (cons? (tl (tl V2761))) (and (cons? (tl (tl (tl V2761)))) (= (hd (tl V2761)) bar!))))) (simple-error "misapplication of | -")) ((cons? V2761) (cons cons (cons (hd V2761) (cons (shen.cons-form (tl V2761)) ())))) (true (shen.f-error shen.cons-form)))) - -(defun shen. (V2762) (let W2763 (if (shen.hds=? V2762 40) (let W2764 (tail V2762) (shen.comb W2764 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2763) (shen.parse-failure) W2763))) - -(defun shen. (V2765) (let W2766 (if (shen.hds=? V2765 41) (let W2767 (tail V2765) (shen.comb W2767 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2766) (shen.parse-failure) W2766))) - -(defun shen. (V2768) (let W2769 (if (shen.hds=? V2768 123) (let W2770 (tail V2768) (shen.comb W2770 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2769) (shen.parse-failure) W2769))) - -(defun shen. (V2771) (let W2772 (if (shen.hds=? V2771 125) (let W2773 (tail V2771) (shen.comb W2773 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2772) (shen.parse-failure) W2772))) - -(defun shen. (V2774) (let W2775 (if (shen.hds=? V2774 124) (let W2776 (tail V2774) (shen.comb W2776 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2775) (shen.parse-failure) W2775))) - -(defun shen. (V2777) (let W2778 (if (shen.hds=? V2777 59) (let W2779 (tail V2777) (shen.comb W2779 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2778) (shen.parse-failure) W2778))) - -(defun shen. (V2780) (let W2781 (if (shen.hds=? V2780 58) (let W2782 (tail V2780) (shen.comb W2782 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2781) (shen.parse-failure) W2781))) - -(defun shen. (V2783) (let W2784 (if (shen.hds=? V2783 44) (let W2785 (tail V2783) (shen.comb W2785 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2784) (shen.parse-failure) W2784))) - -(defun shen. (V2786) (let W2787 (if (shen.hds=? V2786 61) (let W2788 (tail V2786) (shen.comb W2788 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2787) (shen.parse-failure) W2787))) - -(defun shen. (V2789) (let W2790 (let W2791 (shen. V2789) (if (shen.parse-failure? W2791) (shen.parse-failure) (let W2792 (shen.in-> W2791) (shen.comb W2792 shen.skip)))) (if (shen.parse-failure? W2790) (let W2793 (let W2794 (shen. V2789) (if (shen.parse-failure? W2794) (shen.parse-failure) (let W2795 (shen.in-> W2794) (shen.comb W2795 shen.skip)))) (if (shen.parse-failure? W2793) (shen.parse-failure) W2793)) W2790))) - -(defun shen. (V2796) (let W2797 (let W2798 (shen. V2796) (if (shen.parse-failure? W2798) (shen.parse-failure) (let W2799 (shen.in-> W2798) (let W2800 (shen. W2799) (if (shen.parse-failure? W2800) (shen.parse-failure) (let W2801 (shen.in-> W2800) (let W2802 (shen. W2801) (if (shen.parse-failure? W2802) (shen.parse-failure) (let W2803 (shen.in-> W2802) (let W2804 (shen. W2803) (if (shen.parse-failure? W2804) (shen.parse-failure) (let W2805 (shen.in-> W2804) (shen.comb W2805 shen.skip))))))))))))) (if (shen.parse-failure? W2797) (shen.parse-failure) W2797))) - -(defun shen. (V2806) (let W2807 (if (shen.hds=? V2806 92) (let W2808 (tail V2806) (shen.comb W2808 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2807) (shen.parse-failure) W2807))) - -(defun shen. (V2809) (let W2810 (let W2811 (shen. V2809) (if (shen.parse-failure? W2811) (shen.parse-failure) (let W2812 (shen.in-> W2811) (let W2813 (shen. W2812) (if (shen.parse-failure? W2813) (shen.parse-failure) (let W2814 (shen.in-> W2813) (shen.comb W2814 shen.skip))))))) (if (shen.parse-failure? W2810) (let W2815 (let W2816 ( V2809) (if (shen.parse-failure? W2816) (shen.parse-failure) (let W2817 (shen.in-> W2816) (shen.comb W2817 shen.skip)))) (if (shen.parse-failure? W2815) (shen.parse-failure) W2815)) W2810))) - -(defun shen. (V2818) (let W2819 (if (cons? V2818) (let W2820 (head V2818) (let W2821 (tail V2818) (if (not (shen.return? W2820)) (shen.comb W2821 shen.skip) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W2819) (shen.parse-failure) W2819))) - -(defun shen. (V2822) (let W2823 (let W2824 (shen. V2822) (if (shen.parse-failure? W2824) (shen.parse-failure) (let W2825 (shen.in-> W2824) (let W2826 (shen. W2825) (if (shen.parse-failure? W2826) (shen.parse-failure) (let W2827 (shen.in-> W2826) (shen.comb W2827 shen.skip))))))) (if (shen.parse-failure? W2823) (let W2828 (let W2829 (shen. V2822) (if (shen.parse-failure? W2829) (shen.parse-failure) (let W2830 (shen.in-> W2829) (shen.comb W2830 shen.skip)))) (if (shen.parse-failure? W2828) (shen.parse-failure) W2828)) W2823))) - -(defun shen. (V2831) (let W2832 (if (cons? V2831) (let W2833 (head V2831) (let W2834 (tail V2831) (if (shen.return? W2833) (shen.comb W2834 shen.skip) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W2832) (shen.parse-failure) W2832))) - -(defun shen.return? (V2835) (element? V2835 (cons 9 (cons 10 (cons 13 ()))))) - -(defun shen. (V2836) (let W2837 (let W2838 (shen. V2836) (if (shen.parse-failure? W2838) (shen.parse-failure) (let W2839 (shen.in-> W2838) (let W2840 (shen. W2839) (if (shen.parse-failure? W2840) (shen.parse-failure) (let W2841 (shen.in-> W2840) (let W2842 (shen. W2841) (if (shen.parse-failure? W2842) (shen.parse-failure) (let W2843 (shen.in-> W2842) (shen.comb W2843 shen.skip)))))))))) (if (shen.parse-failure? W2837) (shen.parse-failure) W2837))) - -(defun shen. (V2844) (let W2845 (if (shen.hds=? V2844 42) (let W2846 (tail V2844) (shen.comb W2846 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2845) (shen.parse-failure) W2845))) - -(defun shen. (V2847) (let W2848 (let W2849 (shen. V2847) (if (shen.parse-failure? W2849) (shen.parse-failure) (let W2850 (shen.in-> W2849) (let W2851 (shen. W2850) (if (shen.parse-failure? W2851) (shen.parse-failure) (let W2852 (shen.in-> W2851) (shen.comb W2852 shen.skip))))))) (if (shen.parse-failure? W2848) (let W2853 (let W2854 (shen. V2847) (if (shen.parse-failure? W2854) (shen.parse-failure) (let W2855 (shen.in-> W2854) (let W2856 (shen. W2855) (if (shen.parse-failure? W2856) (shen.parse-failure) (let W2857 (shen.in-> W2856) (shen.comb W2857 shen.skip))))))) (if (shen.parse-failure? W2853) (let W2858 (if (cons? V2847) (let W2859 (tail V2847) (let W2860 (shen. W2859) (if (shen.parse-failure? W2860) (shen.parse-failure) (let W2861 (shen.in-> W2860) (shen.comb W2861 shen.skip))))) (shen.parse-failure)) (if (shen.parse-failure? W2858) (shen.parse-failure) W2858)) W2853)) W2848))) - -(defun shen. (V2862) (let W2863 (let W2864 (shen. V2862) (if (shen.parse-failure? W2864) (shen.parse-failure) (let W2865 (shen.<-out W2864) (let W2866 (shen.in-> W2864) (shen.comb W2866 W2865))))) (if (shen.parse-failure? W2863) (let W2867 (let W2868 (shen. V2862) (if (shen.parse-failure? W2868) (shen.parse-failure) (let W2869 (shen.<-out W2868) (let W2870 (shen.in-> W2868) (shen.comb W2870 W2869))))) (if (shen.parse-failure? W2867) (let W2871 (let W2872 (shen. V2862) (if (shen.parse-failure? W2872) (shen.parse-failure) (let W2873 (shen.<-out W2872) (let W2874 (shen.in-> W2872) (shen.comb W2874 (if (= W2873 "<>") (cons vector (cons 0 ())) (intern W2873))))))) (if (shen.parse-failure? W2871) (shen.parse-failure) W2871)) W2867)) W2863))) - -(defun shen. (V2875) (let W2876 (let W2877 (shen. V2875) (if (shen.parse-failure? W2877) (shen.parse-failure) (let W2878 (shen.<-out W2877) (let W2879 (shen.in-> W2877) (let W2880 (shen. W2879) (if (shen.parse-failure? W2880) (shen.parse-failure) (let W2881 (shen.<-out W2880) (let W2882 (shen.in-> W2880) (shen.comb W2882 (cn W2878 W2881)))))))))) (if (shen.parse-failure? W2876) (shen.parse-failure) W2876))) - -(defun shen. (V2883) (let W2884 (if (cons? V2883) (let W2885 (head V2883) (let W2886 (tail V2883) (if (shen.alpha? W2885) (shen.comb W2886 (n->string W2885)) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W2884) (shen.parse-failure) W2884))) - -(defun shen.alpha? (V2887) (or (shen.lowercase? V2887) (or (shen.uppercase? V2887) (shen.misc? V2887)))) - -(defun shen.lowercase? (V2888) (and (>= V2888 97) (<= V2888 122))) - -(defun shen.uppercase? (V2889) (and (>= V2889 65) (<= V2889 90))) - -(defun shen.misc? (V2890) (element? V2890 (cons 61 (cons 45 (cons 42 (cons 47 (cons 43 (cons 95 (cons 63 (cons 36 (cons 33 (cons 64 (cons 126 (cons 46 (cons 62 (cons 60 (cons 38 (cons 37 (cons 39 (cons 35 (cons 96 ()))))))))))))))))))))) - -(defun shen. (V2891) (let W2892 (let W2893 (shen. V2891) (if (shen.parse-failure? W2893) (shen.parse-failure) (let W2894 (shen.<-out W2893) (let W2895 (shen.in-> W2893) (let W2896 (shen. W2895) (if (shen.parse-failure? W2896) (shen.parse-failure) (let W2897 (shen.<-out W2896) (let W2898 (shen.in-> W2896) (shen.comb W2898 (cn W2894 W2897)))))))))) (if (shen.parse-failure? W2892) (let W2899 (let W2900 ( V2891) (if (shen.parse-failure? W2900) (shen.parse-failure) (let W2901 (shen.in-> W2900) (shen.comb W2901 "")))) (if (shen.parse-failure? W2899) (shen.parse-failure) W2899)) W2892))) - -(defun shen. (V2902) (let W2903 (let W2904 (shen. V2902) (if (shen.parse-failure? W2904) (shen.parse-failure) (let W2905 (shen.<-out W2904) (let W2906 (shen.in-> W2904) (shen.comb W2906 W2905))))) (if (shen.parse-failure? W2903) (let W2907 (let W2908 (shen. V2902) (if (shen.parse-failure? W2908) (shen.parse-failure) (let W2909 (shen.<-out W2908) (let W2910 (shen.in-> W2908) (shen.comb W2910 W2909))))) (if (shen.parse-failure? W2907) (shen.parse-failure) W2907)) W2903))) - -(defun shen. (V2911) (let W2912 (if (cons? V2911) (let W2913 (head V2911) (let W2914 (tail V2911) (if (shen.digit? W2913) (shen.comb W2914 (n->string W2913)) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W2912) (shen.parse-failure) W2912))) - -(defun shen.digit? (V2915) (and (>= V2915 48) (<= V2915 57))) - -(defun shen. (V2916) (let W2917 (let W2918 (shen. V2916) (if (shen.parse-failure? W2918) (shen.parse-failure) (let W2919 (shen.in-> W2918) (let W2920 (shen. W2919) (if (shen.parse-failure? W2920) (shen.parse-failure) (let W2921 (shen.<-out W2920) (let W2922 (shen.in-> W2920) (let W2923 (shen. W2922) (if (shen.parse-failure? W2923) (shen.parse-failure) (let W2924 (shen.in-> W2923) (shen.comb W2924 W2921))))))))))) (if (shen.parse-failure? W2917) (shen.parse-failure) W2917))) - -(defun shen. (V2925) (let W2926 (if (shen.hds=? V2925 34) (let W2927 (tail V2925) (shen.comb W2927 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2926) (shen.parse-failure) W2926))) - -(defun shen. (V2928) (let W2929 (let W2930 (shen. V2928) (if (shen.parse-failure? W2930) (shen.parse-failure) (let W2931 (shen.<-out W2930) (let W2932 (shen.in-> W2930) (let W2933 (shen. W2932) (if (shen.parse-failure? W2933) (shen.parse-failure) (let W2934 (shen.<-out W2933) (let W2935 (shen.in-> W2933) (shen.comb W2935 (cn W2931 W2934)))))))))) (if (shen.parse-failure? W2929) (let W2936 (let W2937 ( V2928) (if (shen.parse-failure? W2937) (shen.parse-failure) (let W2938 (shen.in-> W2937) (shen.comb W2938 "")))) (if (shen.parse-failure? W2936) (shen.parse-failure) W2936)) W2929))) - -(defun shen. (V2939) (let W2940 (let W2941 (shen. V2939) (if (shen.parse-failure? W2941) (shen.parse-failure) (let W2942 (shen.<-out W2941) (let W2943 (shen.in-> W2941) (shen.comb W2943 W2942))))) (if (shen.parse-failure? W2940) (let W2944 (let W2945 (shen. V2939) (if (shen.parse-failure? W2945) (shen.parse-failure) (let W2946 (shen.<-out W2945) (let W2947 (shen.in-> W2945) (shen.comb W2947 W2946))))) (if (shen.parse-failure? W2944) (shen.parse-failure) W2944)) W2940))) - -(defun shen. (V2948) (let W2949 (let W2950 (shen. V2948) (if (shen.parse-failure? W2950) (shen.parse-failure) (let W2951 (shen.in-> W2950) (let W2952 (shen. W2951) (if (shen.parse-failure? W2952) (shen.parse-failure) (let W2953 (shen.in-> W2952) (let W2954 (shen. W2953) (if (shen.parse-failure? W2954) (shen.parse-failure) (let W2955 (shen.<-out W2954) (let W2956 (shen.in-> W2954) (let W2957 (shen. W2956) (if (shen.parse-failure? W2957) (shen.parse-failure) (let W2958 (shen.in-> W2957) (shen.comb W2958 (n->string W2955))))))))))))))) (if (shen.parse-failure? W2949) (shen.parse-failure) W2949))) - -(defun shen. (V2959) (let W2960 (if (cons? V2959) (let W2961 (head V2959) (let W2962 (tail V2959) (if (not (= W2961 34)) (shen.comb W2962 (n->string W2961)) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W2960) (shen.parse-failure) W2960))) - -(defun shen. (V2963) (let W2964 (if (shen.hds=? V2963 99) (let W2965 (tail V2963) (shen.comb W2965 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2964) (shen.parse-failure) W2964))) - -(defun shen. (V2966) (let W2967 (if (shen.hds=? V2966 35) (let W2968 (tail V2966) (shen.comb W2968 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2967) (shen.parse-failure) W2967))) - -(defun shen. (V2969) (let W2970 (let W2971 (shen. V2969) (if (shen.parse-failure? W2971) (shen.parse-failure) (let W2972 (shen.in-> W2971) (let W2973 (shen. W2972) (if (shen.parse-failure? W2973) (shen.parse-failure) (let W2974 (shen.<-out W2973) (let W2975 (shen.in-> W2973) (shen.comb W2975 (- 0 W2974))))))))) (if (shen.parse-failure? W2970) (let W2976 (let W2977 (shen. V2969) (if (shen.parse-failure? W2977) (shen.parse-failure) (let W2978 (shen.in-> W2977) (let W2979 (shen. W2978) (if (shen.parse-failure? W2979) (shen.parse-failure) (let W2980 (shen.<-out W2979) (let W2981 (shen.in-> W2979) (shen.comb W2981 W2980)))))))) (if (shen.parse-failure? W2976) (let W2982 (let W2983 (shen. V2969) (if (shen.parse-failure? W2983) (shen.parse-failure) (let W2984 (shen.<-out W2983) (let W2985 (shen.in-> W2983) (shen.comb W2985 W2984))))) (if (shen.parse-failure? W2982) (let W2986 (let W2987 (shen. V2969) (if (shen.parse-failure? W2987) (shen.parse-failure) (let W2988 (shen.<-out W2987) (let W2989 (shen.in-> W2987) (shen.comb W2989 W2988))))) (if (shen.parse-failure? W2986) (let W2990 (let W2991 (shen. V2969) (if (shen.parse-failure? W2991) (shen.parse-failure) (let W2992 (shen.<-out W2991) (let W2993 (shen.in-> W2991) (shen.comb W2993 W2992))))) (if (shen.parse-failure? W2990) (shen.parse-failure) W2990)) W2986)) W2982)) W2976)) W2970))) - -(defun shen. (V2994) (let W2995 (if (shen.hds=? V2994 45) (let W2996 (tail V2994) (shen.comb W2996 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2995) (shen.parse-failure) W2995))) - -(defun shen. (V2997) (let W2998 (if (shen.hds=? V2997 43) (let W2999 (tail V2997) (shen.comb W2999 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W2998) (shen.parse-failure) W2998))) - -(defun shen. (V3000) (let W3001 (let W3002 (shen. V3000) (if (shen.parse-failure? W3002) (shen.parse-failure) (let W3003 (shen.<-out W3002) (let W3004 (shen.in-> W3002) (shen.comb W3004 (shen.compute-integer W3003)))))) (if (shen.parse-failure? W3001) (shen.parse-failure) W3001))) - -(defun shen. (V3005) (let W3006 (let W3007 (shen. V3005) (if (shen.parse-failure? W3007) (shen.parse-failure) (let W3008 (shen.<-out W3007) (let W3009 (shen.in-> W3007) (let W3010 (shen. W3009) (if (shen.parse-failure? W3010) (shen.parse-failure) (let W3011 (shen.<-out W3010) (let W3012 (shen.in-> W3010) (shen.comb W3012 (cons W3008 W3011)))))))))) (if (shen.parse-failure? W3006) (let W3013 (let W3014 (shen. V3005) (if (shen.parse-failure? W3014) (shen.parse-failure) (let W3015 (shen.<-out W3014) (let W3016 (shen.in-> W3014) (shen.comb W3016 (cons W3015 ())))))) (if (shen.parse-failure? W3013) (shen.parse-failure) W3013)) W3006))) - -(defun shen. (V3017) (let W3018 (if (cons? V3017) (let W3019 (head V3017) (let W3020 (tail V3017) (if (shen.digit? W3019) (shen.comb W3020 (shen.byte->digit W3019)) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W3018) (shen.parse-failure) W3018))) - -(defun shen.byte->digit (V3021) (- V3021 48)) - -(defun shen.compute-integer (V3022) (shen.compute-integer-h (reverse V3022) 0)) - -(defun shen.compute-integer-h (V3025 V3026) (cond ((= () V3025) 0) ((cons? V3025) (+ (* (shen.expt 10 V3026) (hd V3025)) (shen.compute-integer-h (tl V3025) (+ V3026 1)))) (true (shen.f-error shen.compute-integer-h)))) - -(defun shen.expt (V3029 V3030) (cond ((= 0 V3030) 1) ((> V3030 0) (* V3029 (shen.expt V3029 (- V3030 1)))) (true (/ (shen.expt V3029 (+ V3030 1)) V3029)))) - -(defun shen. (V3031) (let W3032 (let W3033 (shen. V3031) (if (shen.parse-failure? W3033) (shen.parse-failure) (let W3034 (shen.<-out W3033) (let W3035 (shen.in-> W3033) (let W3036 (shen. W3035) (if (shen.parse-failure? W3036) (shen.parse-failure) (let W3037 (shen.in-> W3036) (let W3038 (shen. W3037) (if (shen.parse-failure? W3038) (shen.parse-failure) (let W3039 (shen.<-out W3038) (let W3040 (shen.in-> W3038) (shen.comb W3040 (+ W3034 W3039))))))))))))) (if (shen.parse-failure? W3032) (let W3041 (let W3042 (shen. V3031) (if (shen.parse-failure? W3042) (shen.parse-failure) (let W3043 (shen.in-> W3042) (let W3044 (shen. W3043) (if (shen.parse-failure? W3044) (shen.parse-failure) (let W3045 (shen.<-out W3044) (let W3046 (shen.in-> W3044) (shen.comb W3046 W3045)))))))) (if (shen.parse-failure? W3041) (shen.parse-failure) W3041)) W3032))) - -(defun shen. (V3047) (let W3048 (if (shen.hds=? V3047 46) (let W3049 (tail V3047) (shen.comb W3049 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W3048) (shen.parse-failure) W3048))) - -(defun shen. (V3050) (let W3051 (let W3052 (shen. V3050) (if (shen.parse-failure? W3052) (shen.parse-failure) (let W3053 (shen.<-out W3052) (let W3054 (shen.in-> W3052) (shen.comb W3054 (shen.compute-fraction W3053)))))) (if (shen.parse-failure? W3051) (shen.parse-failure) W3051))) - -(defun shen.compute-fraction (V3055) (shen.compute-fraction-h V3055 -1)) - -(defun shen.compute-fraction-h (V3058 V3059) (cond ((= () V3058) 0) ((cons? V3058) (+ (* (shen.expt 10 V3059) (hd V3058)) (shen.compute-fraction-h (tl V3058) (- V3059 1)))) (true (shen.f-error shen.compute-fraction-h)))) - -(defun shen. (V3060) (let W3061 (let W3062 (shen. V3060) (if (shen.parse-failure? W3062) (shen.parse-failure) (let W3063 (shen.<-out W3062) (let W3064 (shen.in-> W3062) (let W3065 (shen. W3064) (if (shen.parse-failure? W3065) (shen.parse-failure) (let W3066 (shen.in-> W3065) (let W3067 (shen. W3066) (if (shen.parse-failure? W3067) (shen.parse-failure) (let W3068 (shen.<-out W3067) (let W3069 (shen.in-> W3067) (shen.comb W3069 (shen.compute-E W3063 W3068))))))))))))) (if (shen.parse-failure? W3061) (let W3070 (let W3071 (shen. V3060) (if (shen.parse-failure? W3071) (shen.parse-failure) (let W3072 (shen.<-out W3071) (let W3073 (shen.in-> W3071) (let W3074 (shen. W3073) (if (shen.parse-failure? W3074) (shen.parse-failure) (let W3075 (shen.in-> W3074) (let W3076 (shen. W3075) (if (shen.parse-failure? W3076) (shen.parse-failure) (let W3077 (shen.<-out W3076) (let W3078 (shen.in-> W3076) (shen.comb W3078 (shen.compute-E W3072 W3077))))))))))))) (if (shen.parse-failure? W3070) (shen.parse-failure) W3070)) W3061))) - -(defun shen. (V3079) (let W3080 (let W3081 (shen. V3079) (if (shen.parse-failure? W3081) (shen.parse-failure) (let W3082 (shen.in-> W3081) (let W3083 (shen. W3082) (if (shen.parse-failure? W3083) (shen.parse-failure) (let W3084 (shen.<-out W3083) (let W3085 (shen.in-> W3083) (shen.comb W3085 W3084)))))))) (if (shen.parse-failure? W3080) (let W3086 (let W3087 (shen. V3079) (if (shen.parse-failure? W3087) (shen.parse-failure) (let W3088 (shen.in-> W3087) (let W3089 (shen. W3088) (if (shen.parse-failure? W3089) (shen.parse-failure) (let W3090 (shen.<-out W3089) (let W3091 (shen.in-> W3089) (shen.comb W3091 (- 0 W3090))))))))) (if (shen.parse-failure? W3086) (let W3092 (let W3093 (shen. V3079) (if (shen.parse-failure? W3093) (shen.parse-failure) (let W3094 (shen.<-out W3093) (let W3095 (shen.in-> W3093) (shen.comb W3095 W3094))))) (if (shen.parse-failure? W3092) (shen.parse-failure) W3092)) W3086)) W3080))) - -(defun shen. (V3096) (let W3097 (if (shen.hds=? V3096 101) (let W3098 (tail V3096) (shen.comb W3098 shen.skip)) (shen.parse-failure)) (if (shen.parse-failure? W3097) (shen.parse-failure) W3097))) - -(defun shen.compute-E (V3099 V3100) (* V3099 (shen.expt 10 V3100))) - -(defun shen. (V3101) (let W3102 (let W3103 (shen. V3101) (if (shen.parse-failure? W3103) (shen.parse-failure) (let W3104 (shen.in-> W3103) (let W3105 (shen. W3104) (if (shen.parse-failure? W3105) (shen.parse-failure) (let W3106 (shen.in-> W3105) (shen.comb W3106 shen.skip))))))) (if (shen.parse-failure? W3102) (let W3107 (let W3108 (shen. V3101) (if (shen.parse-failure? W3108) (shen.parse-failure) (let W3109 (shen.in-> W3108) (shen.comb W3109 shen.skip)))) (if (shen.parse-failure? W3107) (shen.parse-failure) W3107)) W3102))) - -(defun shen. (V3110) (let W3111 (if (cons? V3110) (let W3112 (head V3110) (let W3113 (tail V3110) (if (shen.whitespace? W3112) (shen.comb W3113 shen.skip) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W3111) (shen.parse-failure) W3111))) - -(defun shen.whitespace? (V3116) (cond ((= 32 V3116) true) ((= 13 V3116) true) ((= 10 V3116) true) ((= 9 V3116) true) (true false))) - -(defun shen.unpackage¯oexpand (V3117) (cond ((= () V3117) ()) ((and (cons? V3117) (shen.packaged? (hd V3117))) (shen.unpackage¯oexpand (append (shen.unpackage (hd V3117)) (tl V3117)))) ((cons? V3117) (let W3118 (macroexpand (hd V3117)) (if (shen.packaged? W3118) (shen.unpackage¯oexpand (cons W3118 (tl V3117))) (cons W3118 (shen.unpackage¯oexpand (tl V3117)))))) (true (shen.f-error shen.unpackage¯oexpand)))) - -(defun shen.packaged? (V3121) (cond ((and (cons? V3121) (and (= package (hd V3121)) (and (cons? (tl V3121)) (cons? (tl (tl V3121)))))) true) (true false))) - -(defun shen.unpackage (V3124) (cond ((and (cons? V3124) (and (= package (hd V3124)) (and (cons? (tl V3124)) (and (= null (hd (tl V3124))) (cons? (tl (tl V3124))))))) (tl (tl (tl V3124)))) ((and (cons? V3124) (and (= package (hd V3124)) (and (cons? (tl V3124)) (cons? (tl (tl V3124)))))) (let W3125 (eval (hd (tl (tl V3124)))) (let W3126 (shen.package-symbols (str (hd (tl V3124))) W3125 (tl (tl (tl V3124)))) (let W3127 (shen.record-external (hd (tl V3124)) W3125) (let W3128 (shen.record-internal (hd (tl V3124)) W3125 (tl (tl (tl V3124)))) W3126))))) (true (shen.f-error shen.unpackage)))) - -(defun shen.record-internal (V3129 V3130 V3131) (let W3132 (trap-error (get V3129 shen.internal-symbols (value *property-vector*)) (lambda Z3133 ())) (let W3134 (shen.internal-symbols (str V3129) V3130 V3131) (put V3129 shen.internal-symbols (union W3134 W3132) (value *property-vector*))))) - -(defun shen.internal-symbols (V3141 V3142 V3143) (cond ((cons? V3143) (union (shen.internal-symbols V3141 V3142 (hd V3143)) (shen.internal-symbols V3141 V3142 (tl V3143)))) ((shen.internal? V3143 V3141 V3142) (cons (shen.intern-in-package V3141 V3143) ())) (true ()))) - -(defun shen.record-external (V3144 V3145) (let W3146 (trap-error (get V3144 shen.external-symbols (value *property-vector*)) (lambda Z3147 ())) (put V3144 shen.external-symbols (union V3145 W3146) (value *property-vector*)))) - -(defun shen.package-symbols (V3152 V3153 V3154) (cond ((cons? V3154) (map (lambda Z3155 (shen.package-symbols V3152 V3153 Z3155)) V3154)) ((shen.internal? V3154 V3152 V3153) (shen.intern-in-package V3152 V3154)) (true V3154))) - -(defun shen.intern-in-package (V3156 V3157) (intern (@s V3156 (@s "." (str V3157))))) - -(defun shen.internal? (V3158 V3159 V3160) (and (not (element? V3158 V3160)) (and (not (shen.sng? V3158)) (and (not (shen.dbl? V3158)) (and (symbol? V3158) (and (not (shen.sysfunc? V3158)) (and (not (variable? V3158)) (and (not (shen.internal-to-shen? (str V3158))) (not (shen.internal-to-P? V3159 (str V3158))))))))))) - -(defun shen.internal-to-shen? (V3165) (cond ((and (shen.+string? V3165) (and (= "s" (hdstr V3165)) (and (shen.+string? (tlstr V3165)) (and (= "h" (hdstr (tlstr V3165))) (and (shen.+string? (tlstr (tlstr V3165))) (and (= "e" (hdstr (tlstr (tlstr V3165)))) (and (shen.+string? (tlstr (tlstr (tlstr V3165)))) (and (= "n" (hdstr (tlstr (tlstr (tlstr V3165))))) (and (shen.+string? (tlstr (tlstr (tlstr (tlstr V3165))))) (= "." (hdstr (tlstr (tlstr (tlstr (tlstr V3165))))))))))))))) true) (true false))) - -(defun shen.sysfunc? (V3166) (element? V3166 (get shen shen.external-symbols (value *property-vector*)))) - -(defun shen.internal-to-P? (V3174 V3175) (cond ((and (= "" V3174) (and (shen.+string? V3175) (= "." (hdstr V3175)))) true) ((and (shen.+string? V3174) (and (shen.+string? V3175) (= (hdstr V3174) (hdstr V3175)))) (shen.internal-to-P? (tlstr V3174) (tlstr V3175))) (true false))) - -(defun shen.process-applications (V3178 V3179) (cond ((element? V3178 V3179) V3178) ((and (cons? V3178) (= cond (hd V3178))) (cons cond (shen.process-cond-clauses (tl V3178) V3179))) ((and (cons? V3178) (shen.non-application? (hd V3178))) (shen.special-case (hd V3178) V3178 V3179)) ((cons? V3178) (shen.process-application (map (lambda Z3180 (shen.process-applications Z3180 V3179)) V3178) V3179)) (true V3178))) - -(defun shen.non-application? (V3183) (cond ((= define V3183) true) ((= defun V3183) true) ((= synonyms V3183) true) ((shen.special? V3183) true) ((shen.extraspecial? V3183) true) (true false))) - -(defun shen.special-case (V3188 V3189 V3190) (cond ((and (= lambda V3188) (and (cons? V3189) (and (= lambda (hd V3189)) (and (cons? (tl V3189)) (and (cons? (tl (tl V3189))) (= () (tl (tl (tl V3189))))))))) (cons lambda (cons (hd (tl V3189)) (cons (shen.process-applications (hd (tl (tl V3189))) V3190) ())))) ((and (= let V3188) (and (cons? V3189) (and (= let (hd V3189)) (and (cons? (tl V3189)) (and (cons? (tl (tl V3189))) (and (cons? (tl (tl (tl V3189)))) (= () (tl (tl (tl (tl V3189))))))))))) (cons let (cons (hd (tl V3189)) (cons (shen.process-applications (hd (tl (tl V3189))) V3190) (cons (shen.process-applications (hd (tl (tl (tl V3189)))) V3190) ()))))) ((and (= defun V3188) (and (cons? V3189) (and (= defun (hd V3189)) (and (cons? (tl V3189)) (and (cons? (tl (tl V3189))) (and (cons? (tl (tl (tl V3189)))) (= () (tl (tl (tl (tl V3189))))))))))) V3189) ((and (= define V3188) (and (cons? V3189) (and (= define (hd V3189)) (and (cons? (tl V3189)) (and (cons? (tl (tl V3189))) (= { (hd (tl (tl V3189))))))))) (cons define (cons (hd (tl V3189)) (cons { (shen.process-after-type (hd (tl V3189)) (tl (tl (tl V3189))) V3190))))) ((and (= define V3188) (and (cons? V3189) (and (= define (hd V3189)) (cons? (tl V3189))))) (cons define (cons (hd (tl V3189)) (map (lambda Z3191 (shen.process-applications Z3191 V3190)) (tl (tl V3189)))))) ((= synonyms V3188) (cons synonyms V3189)) ((and (= type V3188) (and (cons? V3189) (and (= type (hd V3189)) (and (cons? (tl V3189)) (and (cons? (tl (tl V3189))) (= () (tl (tl (tl V3189))))))))) (cons type (cons (shen.process-applications (hd (tl V3189)) V3190) (tl (tl V3189))))) ((and (= input+ V3188) (and (cons? V3189) (and (= input+ (hd V3189)) (and (cons? (tl V3189)) (and (cons? (tl (tl V3189))) (= () (tl (tl (tl V3189))))))))) (cons input+ (cons (hd (tl V3189)) (cons (shen.process-applications (hd (tl (tl V3189))) V3190) ())))) ((and (cons? V3189) (shen.special? (hd V3189))) (cons (hd V3189) (map (lambda Z3192 (shen.process-applications Z3192 V3190)) (tl V3189)))) ((and (cons? V3189) (shen.extraspecial? (hd V3189))) V3189) (true (shen.f-error shen.special-case)))) - -(defun shen.process-cond-clauses (V3195 V3196) (cond ((= () V3195) ()) ((and (cons? V3195) (and (cons? (hd V3195)) (and (cons? (tl (hd V3195))) (= () (tl (tl (hd V3195))))))) (cons (cons (shen.process-applications (hd (hd V3195)) V3196) (cons (shen.process-applications (hd (tl (hd V3195))) V3196) ())) (shen.process-cond-clauses (tl V3195) V3196))) (true (shen.f-error shen.process-cond-clauses)))) - -(defun shen.process-after-type (V3199 V3200 V3201) (cond ((and (cons? V3200) (= } (hd V3200))) (cons } (map (lambda Z3202 (shen.process-applications Z3202 V3201)) (tl V3200)))) ((cons? V3200) (cons (hd V3200) (shen.process-after-type V3199 (tl V3200) V3201))) (true (simple-error (cn "missing } in " (shen.app V3199 " -" shen.a)))))) - -(defun shen.process-application (V3203 V3204) (cond ((cons? V3203) (let W3205 (arity (hd V3203)) (let W3206 (length (tl V3203)) (if (element? V3203 V3204) V3203 (if (shen.shen-call? (hd V3203)) V3203 (if (shen.foreign? V3203) (shen.unpack-foreign V3203) (if (shen.fn-call? V3203) (shen.fn-call V3203) (if (shen.zero-place? V3203) V3203 (if (shen.undefined-f? (hd V3203) W3205) (shen.simple-curry (cons (cons fn (cons (hd V3203) ())) (tl V3203))) (if (variable? (hd V3203)) (shen.simple-curry V3203) (if (shen.application? (hd V3203)) (shen.simple-curry V3203) (if (shen.partial-application*? (hd V3203) W3205 W3206) (shen.lambda-function V3203 (- W3205 W3206)) (if (shen.overapplication? (hd V3203) W3205 W3206) (shen.simple-curry (cons (cons fn (cons (hd V3203) ())) (tl V3203))) V3203))))))))))))) (true (shen.f-error shen.process-application)))) - -(defun shen.unpack-foreign (V3207) (cond ((and (cons? V3207) (and (cons? (hd V3207)) (and (= foreign (hd (hd V3207))) (and (cons? (tl (hd V3207))) (= () (tl (tl (hd V3207)))))))) (cons (hd (tl (hd V3207))) (tl V3207))) (true (shen.f-error shen.unpack-foreign)))) - -(defun shen.foreign? (V3210) (cond ((and (cons? V3210) (and (cons? (hd V3210)) (and (= foreign (hd (hd V3210))) (and (cons? (tl (hd V3210))) (= () (tl (tl (hd V3210)))))))) true) (true false))) - -(defun shen.zero-place? (V3213) (cond ((and (cons? V3213) (= () (tl V3213))) true) (true false))) - -(defun shen.shen-call? (V3214) (and (symbol? V3214) (shen.internal-to-shen? (str V3214)))) - -(defun shen.application? (V3219) (cond ((and (cons? V3219) (and (= protect (hd V3219)) (and (cons? (tl V3219)) (= () (tl (tl V3219)))))) false) ((and (cons? V3219) (and (= foreign (hd V3219)) (and (cons? (tl V3219)) (= () (tl (tl V3219)))))) false) (true (cons? V3219)))) - -(defun shen.undefined-f? (V3224 V3225) (cond ((= -1 V3225) (and (shen.lowercase-symbol? V3224) (not (element? V3224 (external shen))))) (true false))) - -(defun shen.lowercase-symbol? (V3226) (and (symbol? V3226) (not (variable? V3226)))) - -(defun shen.simple-curry (V3227) (cond ((and (cons? V3227) (and (cons? (tl V3227)) (= () (tl (tl V3227))))) V3227) ((and (cons? V3227) (and (cons? (tl V3227)) (cons? (tl (tl V3227))))) (shen.simple-curry (cons (cons (hd V3227) (cons (hd (tl V3227)) ())) (tl (tl V3227))))) (true V3227))) - -(defun function (V3228) (fn V3228)) - -(defun fn (V3229) (cond ((= (arity V3229) 0) (V3229)) (true (trap-error (get V3229 shen.lambda-form (value *property-vector*)) (lambda Z3230 (simple-error (cn "fn: " (shen.app V3229 " is undefined -" shen.a)))))))) - -(defun shen.fn-call? (V3233) (cond ((and (cons? V3233) (and (= fn (hd V3233)) (and (cons? (tl V3233)) (= () (tl (tl V3233)))))) true) ((and (cons? V3233) (and (= function (hd V3233)) (and (cons? (tl V3233)) (= () (tl (tl V3233)))))) true) (true false))) - -(defun shen.fn-call (V3234) (cond ((and (cons? V3234) (and (= function (hd V3234)) (and (cons? (tl V3234)) (= () (tl (tl V3234)))))) (shen.fn-call (cons fn (tl V3234)))) ((and (cons? V3234) (and (= fn (hd V3234)) (and (cons? (tl V3234)) (= () (tl (tl V3234)))))) (let W3235 (arity (hd (tl V3234))) (if (= W3235 -1) V3234 (if (= W3235 0) (tl V3234) (shen.lambda-function (tl V3234) W3235))))) (true (shen.f-error shen.fn-call)))) - -(defun shen.partial-application*? (V3236 V3237 V3238) (let W3239 (> V3237 V3238) (let W3240 (if (and W3239 (and (shen.loading?) (not (element? V3236 (cons + (cons - ())))))) (pr (cn "partial application of " (shen.app V3236 " -" shen.a)) (stoutput)) shen.skip) W3239))) - -(defun shen.loading? () (value shen.*loading?*)) - -(defun shen.overapplication? (V3245 V3246 V3247) (cond ((= -1 V3246) false) (true (let W3248 (< V3246 V3247) (let W3249 (if (and W3248 (shen.loading?)) (pr (shen.app V3245 (cn " might not like " (shen.app V3247 (cn " argument" (shen.app (if (= V3247 1) "" "s") " -" shen.a)) shen.a)) shen.a) (stoutput)) shen.skip) W3248))))) - -(defun shen.compile-prolog (V1640 V1641) (compile (lambda Z1642 (shen. Z1642)) (cons V1640 V1641))) - -(defun shen. (V1643) (let W1644 (if (cons? V1643) (let W1645 (head V1643) (let W1646 (tail V1643) (let W1647 (shen. W1646) (if (shen.parse-failure? W1647) (shen.parse-failure) (let W1648 (shen.<-out W1647) (let W1649 (shen.in-> W1647) (shen.comb W1649 (let W1650 (shen.prolog-arity-check W1645 W1648) (let W1651 (map (lambda Z1652 (shen.linearise-clause Z1652)) W1648) (shen.horn-clause-procedure W1645 W1651)))))))))) (shen.parse-failure)) (if (shen.parse-failure? W1644) (shen.parse-failure) W1644))) - -(defun shen.prolog-arity-check (V1655 V1656) (cond ((and (cons? V1656) (and (cons? (hd V1656)) (and (cons? (tl (hd V1656))) (and (= () (tl (tl (hd V1656)))) (= () (tl V1656)))))) (length (hd (hd V1656)))) ((and (cons? V1656) (and (cons? (hd V1656)) (and (cons? (tl (hd V1656))) (= () (tl (tl (hd V1656))))))) (shen.pac-h V1655 (length (hd (hd V1656))) (tl V1656))) (true (shen.f-error shen.prolog-arity-check)))) - -(defun shen.pac-h (V1661 V1662 V1663) (cond ((= () V1663) V1662) ((and (cons? V1663) (cons? (hd V1663))) (if (= V1662 (length (hd (hd V1663)))) (shen.pac-h V1661 V1662 (tl V1663)) (simple-error (cn "arity error in prolog procedure " (shen.app V1661 " -" shen.a))))) (true (shen.f-error shen.pac-h)))) - -(defun shen. (V1664) (let W1665 (let W1666 (shen. V1664) (if (shen.parse-failure? W1666) (shen.parse-failure) (let W1667 (shen.<-out W1666) (let W1668 (shen.in-> W1666) (let W1669 (shen. W1668) (if (shen.parse-failure? W1669) (shen.parse-failure) (let W1670 (shen.<-out W1669) (let W1671 (shen.in-> W1669) (shen.comb W1671 (cons W1667 W1670)))))))))) (if (shen.parse-failure? W1665) (let W1672 (let W1673 ( V1664) (if (shen.parse-failure? W1673) (shen.parse-failure) (let W1674 (shen.<-out W1673) (let W1675 (shen.in-> W1673) (shen.comb W1675 (if (empty? W1674) () (simple-error (cn "Prolog syntax error here: - " (shen.app W1674 " - ..." shen.r))))))))) (if (shen.parse-failure? W1672) (shen.parse-failure) W1672)) W1665))) - -(defun shen.linearise-clause (V1676) (cond ((and (cons? V1676) (and (cons? (tl V1676)) (= () (tl (tl V1676))))) (shen.lch (shen.linearise (@p (hd V1676) (hd (tl V1676)))))) (true (shen.f-error shen.linearise-clause)))) - -(defun shen.lch (V1677) (cond ((tuple? V1677) (cons (fst V1677) (cons (shen.lchh (snd V1677)) ()))) (true (shen.f-error shen.lch)))) - -(defun shen.lchh (V1678) (cond ((and (cons? V1678) (and (= where (hd V1678)) (and (cons? (tl V1678)) (and (cons? (hd (tl V1678))) (and (= = (hd (hd (tl V1678)))) (and (cons? (tl (hd (tl V1678)))) (and (cons? (tl (tl (hd (tl V1678))))) (and (= () (tl (tl (tl (hd (tl V1678)))))) (and (cons? (tl (tl V1678))) (= () (tl (tl (tl V1678))))))))))))) (cons (cons (if (value shen.*occurs*) is! is) (tl (hd (tl V1678)))) (shen.lchh (hd (tl (tl V1678)))))) (true V1678))) - -(defun shen. (V1679) (let W1680 (let W1681 (shen. V1679) (if (shen.parse-failure? W1681) (shen.parse-failure) (let W1682 (shen.<-out W1681) (let W1683 (shen.in-> W1681) (if (shen.hds=? W1683 <--) (let W1684 (tail W1683) (let W1685 (shen. W1684) (if (shen.parse-failure? W1685) (shen.parse-failure) (let W1686 (shen.<-out W1685) (let W1687 (shen.in-> W1685) (let W1688 (shen. W1687) (if (shen.parse-failure? W1688) (shen.parse-failure) (let W1689 (shen.in-> W1688) (shen.comb W1689 (cons W1682 (cons W1686 ()))))))))))) (shen.parse-failure)))))) (if (shen.parse-failure? W1680) (shen.parse-failure) W1680))) - -(defun shen. (V1690) (let W1691 (let W1692 (shen. V1690) (if (shen.parse-failure? W1692) (shen.parse-failure) (let W1693 (shen.<-out W1692) (let W1694 (shen.in-> W1692) (let W1695 (shen. W1694) (if (shen.parse-failure? W1695) (shen.parse-failure) (let W1696 (shen.<-out W1695) (let W1697 (shen.in-> W1695) (shen.comb W1697 (cons W1693 W1696)))))))))) (if (shen.parse-failure? W1691) (let W1698 (let W1699 ( V1690) (if (shen.parse-failure? W1699) (shen.parse-failure) (let W1700 (shen.in-> W1699) (shen.comb W1700 ())))) (if (shen.parse-failure? W1698) (shen.parse-failure) W1698)) W1691))) - -(defun shen. (V1701) (let W1702 (if (cons? V1701) (let W1703 (head V1701) (let W1704 (tail V1701) (if (and (atom? W1703) (not (shen.prolog-keyword? W1703))) (shen.comb W1704 W1703) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W1702) (let W1705 (if (cons? V1701) (let W1706 (head V1701) (let W1707 (tail V1701) (if (= W1706 (intern ":")) (shen.comb W1707 W1706) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W1705) (let W1708 (if (shen.ccons? V1701) (let W1709 (head V1701) (let W1710 (tail V1701) (if (shen.hds=? W1709 cons) (let W1711 (tail W1709) (let W1712 (shen. W1711) (if (shen.parse-failure? W1712) (shen.parse-failure) (let W1713 (shen.<-out W1712) (let W1714 (shen.in-> W1712) (let W1715 (shen. W1714) (if (shen.parse-failure? W1715) (shen.parse-failure) (let W1716 (shen.<-out W1715) (let W1717 (shen.in-> W1715) (let W1718 ( W1717) (if (shen.parse-failure? W1718) (shen.parse-failure) (let W1719 (shen.in-> W1718) (shen.comb W1710 (cons cons (cons W1713 (cons W1716 ())))))))))))))))) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W1708) (let W1720 (if (shen.ccons? V1701) (let W1721 (head V1701) (let W1722 (tail V1701) (if (shen.hds=? W1721 +) (let W1723 (tail W1721) (let W1724 (shen. W1723) (if (shen.parse-failure? W1724) (shen.parse-failure) (let W1725 (shen.<-out W1724) (let W1726 (shen.in-> W1724) (let W1727 ( W1726) (if (shen.parse-failure? W1727) (shen.parse-failure) (let W1728 (shen.in-> W1727) (shen.comb W1722 (cons shen.+m (cons W1725 ()))))))))))) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W1720) (let W1729 (if (shen.ccons? V1701) (let W1730 (head V1701) (let W1731 (tail V1701) (if (shen.hds=? W1730 -) (let W1732 (tail W1730) (let W1733 (shen. W1732) (if (shen.parse-failure? W1733) (shen.parse-failure) (let W1734 (shen.<-out W1733) (let W1735 (shen.in-> W1733) (let W1736 ( W1735) (if (shen.parse-failure? W1736) (shen.parse-failure) (let W1737 (shen.in-> W1736) (shen.comb W1731 (cons shen.-m (cons W1734 ()))))))))))) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W1729) (let W1738 (if (shen.ccons? V1701) (let W1739 (head V1701) (let W1740 (tail V1701) (if (shen.hds=? W1739 mode) (let W1741 (tail W1739) (let W1742 (shen. W1741) (if (shen.parse-failure? W1742) (shen.parse-failure) (let W1743 (shen.<-out W1742) (let W1744 (shen.in-> W1742) (if (shen.hds=? W1744 +) (let W1745 (tail W1744) (let W1746 ( W1745) (if (shen.parse-failure? W1746) (shen.parse-failure) (let W1747 (shen.in-> W1746) (shen.comb W1740 (cons shen.+m (cons W1743 ()))))))) (shen.parse-failure))))))) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W1738) (let W1748 (if (shen.ccons? V1701) (let W1749 (head V1701) (let W1750 (tail V1701) (if (shen.hds=? W1749 mode) (let W1751 (tail W1749) (let W1752 (shen. W1751) (if (shen.parse-failure? W1752) (shen.parse-failure) (let W1753 (shen.<-out W1752) (let W1754 (shen.in-> W1752) (if (shen.hds=? W1754 -) (let W1755 (tail W1754) (let W1756 ( W1755) (if (shen.parse-failure? W1756) (shen.parse-failure) (let W1757 (shen.in-> W1756) (shen.comb W1750 (cons shen.-m (cons W1753 ()))))))) (shen.parse-failure))))))) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W1748) (shen.parse-failure) W1748)) W1738)) W1729)) W1720)) W1708)) W1705)) W1702))) - -(defun shen.prolog-keyword? (V1758) (element? V1758 (cons (intern ";") (cons <-- ())))) - -(defun atom? (V1759) (or (symbol? V1759) (or (string? V1759) (or (boolean? V1759) (or (number? V1759) (empty? V1759)))))) - -(defun shen. (V1760) (let W1761 (let W1762 (shen. V1760) (if (shen.parse-failure? W1762) (shen.parse-failure) (let W1763 (shen.<-out W1762) (let W1764 (shen.in-> W1762) (shen.comb W1764 W1763))))) (if (shen.parse-failure? W1761) (shen.parse-failure) W1761))) - -(defun shen. (V1765) (let W1766 (let W1767 (shen. V1765) (if (shen.parse-failure? W1767) (shen.parse-failure) (let W1768 (shen.<-out W1767) (let W1769 (shen.in-> W1767) (shen.comb W1769 W1768))))) (if (shen.parse-failure? W1766) (shen.parse-failure) W1766))) - -(defun shen. (V1770) (let W1771 (let W1772 (shen. V1770) (if (shen.parse-failure? W1772) (shen.parse-failure) (let W1773 (shen.<-out W1772) (let W1774 (shen.in-> W1772) (let W1775 (shen. W1774) (if (shen.parse-failure? W1775) (shen.parse-failure) (let W1776 (shen.<-out W1775) (let W1777 (shen.in-> W1775) (shen.comb W1777 (cons W1773 W1776)))))))))) (if (shen.parse-failure? W1771) (let W1778 (let W1779 ( V1770) (if (shen.parse-failure? W1779) (shen.parse-failure) (let W1780 (shen.in-> W1779) (shen.comb W1780 ())))) (if (shen.parse-failure? W1778) (shen.parse-failure) W1778)) W1771))) - -(defun shen. (V1781) (let W1782 (if (shen.hds=? V1781 !) (let W1783 (tail V1781) (shen.comb W1783 !)) (shen.parse-failure)) (if (shen.parse-failure? W1782) (let W1784 (if (shen.ccons? V1781) (let W1785 (head V1781) (let W1786 (tail V1781) (let W1787 (shen. W1785) (if (shen.parse-failure? W1787) (shen.parse-failure) (let W1788 (shen.<-out W1787) (let W1789 (shen.in-> W1787) (let W1790 ( W1789) (if (shen.parse-failure? W1790) (shen.parse-failure) (let W1791 (shen.in-> W1790) (shen.comb W1786 W1788)))))))))) (shen.parse-failure)) (if (shen.parse-failure? W1784) (shen.parse-failure) W1784)) W1782))) - -(defun shen. (V1792) (let W1793 (let W1794 (shen. V1792) (if (shen.parse-failure? W1794) (shen.parse-failure) (let W1795 (shen.<-out W1794) (let W1796 (shen.in-> W1794) (let W1797 (shen. W1796) (if (shen.parse-failure? W1797) (shen.parse-failure) (let W1798 (shen.<-out W1797) (let W1799 (shen.in-> W1797) (shen.comb W1799 (cons W1795 W1798)))))))))) (if (shen.parse-failure? W1793) (let W1800 (let W1801 ( V1792) (if (shen.parse-failure? W1801) (shen.parse-failure) (let W1802 (shen.in-> W1801) (shen.comb W1802 ())))) (if (shen.parse-failure? W1800) (shen.parse-failure) W1800)) W1793))) - -(defun shen. (V1803) (let W1804 (let W1805 (shen. V1803) (if (shen.parse-failure? W1805) (shen.parse-failure) (let W1806 (shen.<-out W1805) (let W1807 (shen.in-> W1805) (shen.comb W1807 W1806))))) (if (shen.parse-failure? W1804) (let W1808 (if (cons? V1803) (let W1809 (head V1803) (let W1810 (tail V1803) (if (atom? W1809) (shen.comb W1810 W1809) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W1808) (let W1811 (if (shen.ccons? V1803) (let W1812 (head V1803) (let W1813 (tail V1803) (let W1814 (shen. W1812) (if (shen.parse-failure? W1814) (shen.parse-failure) (let W1815 (shen.<-out W1814) (let W1816 (shen.in-> W1814) (let W1817 ( W1816) (if (shen.parse-failure? W1817) (shen.parse-failure) (let W1818 (shen.in-> W1817) (shen.comb W1813 W1815)))))))))) (shen.parse-failure)) (if (shen.parse-failure? W1811) (shen.parse-failure) W1811)) W1808)) W1804))) - -(defun shen. (V1819) (let W1820 (if (cons? V1819) (let W1821 (head V1819) (let W1822 (tail V1819) (if (= W1821 _) (shen.comb W1822 (gensym Y)) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W1820) (shen.parse-failure) W1820))) - -(defun shen. (V1823) (let W1824 (if (cons? V1823) (let W1825 (head V1823) (let W1826 (tail V1823) (if (shen.semicolon? W1825) (shen.comb W1826 W1825) (shen.parse-failure)))) (shen.parse-failure)) (if (shen.parse-failure? W1824) (shen.parse-failure) W1824))) - -(defun shen.horn-clause-procedure (V1827 V1828) (let W1829 (gensym B) (let W1830 (gensym L) (let W1831 (gensym K) (let W1832 (gensym C) (let W1833 (shen.prolog-parameters V1828) (let W1834 (shen.hascut? V1828) (let W1835 (shen.prolog-fbody V1828 W1833 W1829 W1830 W1831 W1832 W1834) (let W1836 (if W1834 (cons let (cons W1831 (cons (cons + (cons W1831 (cons 1 ()))) (cons W1835 ())))) W1835) (let W1837 (cons define (cons V1827 (append W1833 (append (cons W1829 (cons W1830 (cons W1831 (cons W1832 (cons -> ()))))) (cons W1836 ()))))) W1837)))))))))) - -(defun shen.hascut? (V1840) (cond ((= ! V1840) true) ((cons? V1840) (or (shen.hascut? (hd V1840)) (shen.hascut? (tl V1840)))) (true false))) - -(defun shen.prolog-parameters (V1845) (cond ((and (cons? V1845) (cons? (hd V1845))) (shen.parameters (length (hd (hd V1845))))) (true (shen.f-error shen.prolog-parameters)))) - -(defun shen.prolog-fbody (V1866 V1867 V1868 V1869 V1870 V1871 V1872) (cond ((and (= () V1866) (= true V1872)) (cons shen.unlock (cons V1869 (cons V1870 ())))) ((and (cons? V1866) (and (cons? (hd V1866)) (and (cons? (tl (hd V1866))) (and (= () (tl (tl (hd V1866)))) (and (= () (tl V1866)) (= false V1872)))))) (let W1873 (shen.continue (hd (hd V1866)) (hd (tl (hd V1866))) V1868 V1869 V1870 V1871) (cons if (cons (cons shen.unlocked? (cons V1869 ())) (cons (shen.compile-head shen.+m (hd (hd V1866)) V1867 V1868 W1873) (cons false ())))))) ((and (cons? V1866) (and (cons? (hd V1866)) (and (cons? (tl (hd V1866))) (= () (tl (tl (hd V1866))))))) (let W1874 (gensym C) (let W1875 (shen.continue (hd (hd V1866)) (hd (tl (hd V1866))) V1868 V1869 V1870 V1871) (cons let (cons W1874 (cons (cons if (cons (cons shen.unlocked? (cons V1869 ())) (cons (shen.compile-head shen.+m (hd (hd V1866)) V1867 V1868 W1875) (cons false ())))) (cons (cons if (cons (cons = (cons W1874 (cons false ()))) (cons (shen.prolog-fbody (tl V1866) V1867 V1868 V1869 V1870 V1871 V1872) (cons W1874 ())))) ()))))))) (true (simple-error "implementation error in shen.prolog-fbody")))) - -(defun shen.unlock (V1876 V1877) (if (and (shen.locked? V1876) (shen.fits? V1877 V1876)) (shen.openlock V1876) false)) - -(defun shen.locked? (V1878) (not (shen.unlocked? V1878))) - -(defun shen.unlocked? (V1879) (<-address V1879 1)) - -(defun shen.openlock (V1880) (do (address-> V1880 1 true) false)) - -(defun shen.fits? (V1881 V1882) (= V1881 (<-address V1882 2))) - -(defun shen.cut (V1885 V1886 V1887 V1888) (let W1889 (thaw V1888) (if (and (= W1889 false) (shen.unlocked? V1886)) (shen.lock V1887 V1886) W1889))) - -(defun shen.lock (V1890 V1891) (let W1892 (address-> V1891 1 false) (let W1893 (address-> V1891 2 V1890) false))) - -(defun shen.continue (V1894 V1895 V1896 V1897 V1898 V1899) (let W1900 (shen.extract-vars V1894) (let W1901 (shen.extract-free-vars V1895) (let W1902 (difference W1901 W1900) (let W1903 (cons do (cons (cons shen.incinfs ()) (cons (shen.compile-body V1895 V1896 V1897 V1898 V1899) ()))) (shen.stpart W1902 W1903 V1896)))))) - -(defun shen.extract-free-vars (V1906) (cond ((and (cons? V1906) (and (= lambda (hd V1906)) (and (cons? (tl V1906)) (and (cons? (tl (tl V1906))) (= () (tl (tl (tl V1906)))))))) (remove (hd (tl V1906)) (shen.extract-free-vars (hd (tl (tl V1906)))))) ((cons? V1906) (union (shen.extract-free-vars (hd V1906)) (shen.extract-free-vars (tl V1906)))) ((variable? V1906) (cons V1906 ())) (true ()))) - -(defun shen.compile-body (V1923 V1924 V1925 V1926 V1927) (cond ((= () V1923) (cons thaw (cons V1927 ()))) ((and (cons? V1923) (= ! (hd V1923))) (shen.compile-body (cons (cons shen.cut ()) (tl V1923)) V1924 V1925 V1926 V1927)) ((and (cons? V1923) (= () (tl V1923))) (append (shen.deref-calls (hd V1923) V1924) (cons V1924 (cons V1925 (cons V1926 (cons V1927 ())))))) ((cons? V1923) (let W1928 (shen.deref-calls (hd V1923) V1924) (append W1928 (cons V1924 (cons V1925 (cons V1926 (cons (shen.freeze-literals (tl V1923) V1924 V1925 V1926 V1927) ()))))))) (true (simple-error "implementation error in shen.compile-fbody")))) - -(defun shen.freeze-literals (V1945 V1946 V1947 V1948 V1949) (cond ((= () V1945) V1949) ((and (cons? V1945) (= ! (hd V1945))) (shen.freeze-literals (cons (cons shen.cut ()) (tl V1945)) V1946 V1947 V1948 V1949)) ((cons? V1945) (let W1950 (shen.deref-calls (hd V1945) V1946) (cons freeze (cons (append W1950 (cons V1946 (cons V1947 (cons V1948 (cons (shen.freeze-literals (tl V1945) V1946 V1947 V1948 V1949) ()))))) ())))) (true (simple-error "implementation error in shen.freeze-literals")))) - -(defun shen.deref-calls (V1955 V1956) (cond ((and (cons? V1955) (= fork (hd V1955))) (cons fork (cons (shen.deref-forked-literals (tl V1955) V1956) ()))) ((cons? V1955) (cons (hd V1955) (map (lambda Z1957 (shen.function-calls Z1957 V1956)) (tl V1955)))) (true (simple-error "implementation error in shen.deref-calls")))) - -(defun shen.deref-forked-literals (V1964 V1965) (cond ((= () V1964) ()) ((cons? V1964) (cons cons (cons (shen.deref-calls (hd V1964) V1965) (cons (shen.deref-forked-literals (tl V1964) V1965) ())))) (true (simple-error "fork requires a list of literals -")))) - -(defun shen.function-calls (V1968 V1969) (cond ((and (cons? V1968) (and (= cons (hd V1968)) (and (cons? (tl V1968)) (and (cons? (tl (tl V1968))) (= () (tl (tl (tl V1968)))))))) (cons cons (cons (shen.function-calls (hd (tl V1968)) V1969) (cons (shen.function-calls (hd (tl (tl V1968))) V1969) ())))) ((cons? V1968) (shen.deref-terms V1968 V1969 ())) (true V1968))) - -(defun shen.deref-terms (V1978 V1979 V1980) (cond ((and (cons? V1978) (and (= 0 (hd V1978)) (and (cons? (tl V1978)) (= () (tl (tl V1978)))))) (if (variable? (hd (tl V1978))) (hd (tl V1978)) (simple-error (cn "attempt to optimise a non-variable " (shen.app (hd (tl V1978)) " -" shen.s))))) ((and (cons? V1978) (and (= 1 (hd V1978)) (and (cons? (tl V1978)) (= () (tl (tl V1978)))))) (if (variable? (hd (tl V1978))) (cons shen.lazyderef (cons (hd (tl V1978)) (cons V1979 ()))) (simple-error (cn "attempt to optimise a non-variable " (shen.app (hd (tl V1978)) " -" shen.s))))) ((and (not (element? V1978 V1980)) (variable? V1978)) (cons shen.deref (cons V1978 (cons V1979 ())))) ((and (cons? V1978) (and (= lambda (hd V1978)) (and (cons? (tl V1978)) (and (cons? (tl (tl V1978))) (= () (tl (tl (tl V1978)))))))) (cons lambda (cons (hd (tl V1978)) (cons (shen.deref-terms (hd (tl (tl V1978))) V1979 (cons (hd (tl V1978)) V1980)) ())))) ((cons? V1978) (map (lambda Z1981 (shen.deref-terms Z1981 V1979 V1980)) V1978)) (true V1978))) - -(defun shen.compile-head (V1999 V2000 V2001 V2002 V2003) (cond ((and (= () V2000) (= () V2001)) V2003) ((and (cons? V2000) (and (cons? (hd V2000)) (and (= shen.+m (hd (hd V2000))) (and (cons? (tl (hd V2000))) (= () (tl (tl (hd V2000)))))))) (shen.compile-head V1999 (cons shen.+m (cons (hd (tl (hd V2000))) (cons V1999 (tl V2000)))) V2001 V2002 V2003)) ((and (cons? V2000) (and (cons? (hd V2000)) (and (= shen.-m (hd (hd V2000))) (and (cons? (tl (hd V2000))) (= () (tl (tl (hd V2000)))))))) (shen.compile-head V1999 (cons shen.-m (cons (hd (tl (hd V2000))) (cons V1999 (tl V2000)))) V2001 V2002 V2003)) ((and (cons? V2000) (= shen.-m (hd V2000))) (shen.compile-head shen.-m (tl V2000) V2001 V2002 V2003)) ((and (cons? V2000) (= shen.+m (hd V2000))) (shen.compile-head shen.+m (tl V2000) V2001 V2002 V2003)) ((and (cons? V2000) (and (cons? V2001) (shen.wildcard? (hd V2000)))) (shen.compile-head V1999 (tl V2000) (tl V2001) V2002 V2003)) ((and (cons? V2000) (variable? (hd V2000))) (shen.variable-case V1999 V2000 V2001 V2002 V2003)) ((and (= shen.-m V1999) (and (cons? V2000) (atom? (hd V2000)))) (shen.atom-case-minus V2000 V2001 V2002 V2003)) ((and (= shen.-m V1999) (and (cons? V2000) (and (cons? (hd V2000)) (and (= cons (hd (hd V2000))) (and (cons? (tl (hd V2000))) (and (cons? (tl (tl (hd V2000)))) (= () (tl (tl (tl (hd V2000))))))))))) (shen.cons-case-minus V2000 V2001 V2002 V2003)) ((and (= shen.+m V1999) (and (cons? V2000) (atom? (hd V2000)))) (shen.atom-case-plus V2000 V2001 V2002 V2003)) ((and (= shen.+m V1999) (and (cons? V2000) (and (cons? (hd V2000)) (and (= cons (hd (hd V2000))) (and (cons? (tl (hd V2000))) (and (cons? (tl (tl (hd V2000)))) (= () (tl (tl (tl (hd V2000))))))))))) (shen.cons-case-plus V2000 V2001 V2002 V2003)) (true (simple-error "implementation error in shen.compile-head")))) - -(defun shen.variable-case (V2014 V2015 V2016 V2017 V2018) (cond ((and (cons? V2015) (cons? V2016)) (if (variable? (hd V2016)) (shen.compile-head V2014 (tl V2015) (tl V2016) V2017 (subst (hd V2016) (hd V2015) V2018)) (cons let (cons (hd V2015) (cons (hd V2016) (cons (shen.compile-head V2014 (tl V2015) (tl V2016) V2017 V2018) ())))))) (true (simple-error "implementation error in shen.variable-case")))) - -(defun shen.atom-case-minus (V2027 V2028 V2029 V2030) (cond ((and (cons? V2027) (cons? V2028)) (let W2031 (gensym Tm) (cons let (cons W2031 (cons (cons shen.lazyderef (cons (hd V2028) (cons V2029 ()))) (cons (cons if (cons (cons = (cons W2031 (cons (hd V2027) ()))) (cons (shen.compile-head shen.-m (tl V2027) (tl V2028) V2029 V2030) (cons false ())))) ())))))) (true (simple-error "implementation error in shen.atom-case-minus")))) - -(defun shen.cons-case-minus (V2040 V2041 V2042 V2043) (cond ((and (cons? V2040) (and (cons? (hd V2040)) (and (= cons (hd (hd V2040))) (and (cons? (tl (hd V2040))) (and (cons? (tl (tl (hd V2040)))) (and (= () (tl (tl (tl (hd V2040))))) (cons? V2041))))))) (let W2044 (gensym Tm) (cons let (cons W2044 (cons (cons shen.lazyderef (cons (hd V2041) (cons V2042 ()))) (cons (cons if (cons (cons cons? (cons W2044 ())) (cons (shen.compile-head shen.-m (cons (hd (tl (hd V2040))) (cons (hd (tl (tl (hd V2040)))) (tl V2040))) (cons (cons hd (cons W2044 ())) (cons (cons tl (cons W2044 ())) (tl V2041))) V2042 V2043) (cons false ())))) ())))))) (true (simple-error "implementation error in shen.cons-case-minus")))) - -(defun shen.atom-case-plus (V2053 V2054 V2055 V2056) (cond ((and (cons? V2053) (cons? V2054)) (let W2057 (gensym Tm) (let W2058 (gensym GoTo) (cons let (cons W2057 (cons (cons shen.lazyderef (cons (hd V2054) (cons V2055 ()))) (cons W2058 (cons (cons freeze (cons (shen.compile-head shen.+m (tl V2053) (tl V2054) V2055 V2056) ())) (cons (cons if (cons (cons = (cons W2057 (cons (hd V2053) ()))) (cons (cons thaw (cons W2058 ())) (cons (cons if (cons (cons shen.pvar? (cons W2057 ())) (cons (cons shen.bind! (cons W2057 (cons (shen.demode (hd V2053)) (cons V2055 (cons W2058 ()))))) (cons false ())))) ())))) ()))))))))) (true (simple-error "implementation error in shen.atom-case-plus")))) - -(defun shen.cons-case-plus (V2067 V2068 V2069 V2070) (cond ((and (cons? V2067) (and (cons? (hd V2067)) (and (= cons (hd (hd V2067))) (and (cons? (tl (hd V2067))) (and (cons? (tl (tl (hd V2067)))) (and (= () (tl (tl (tl (hd V2067))))) (cons? V2068))))))) (let W2071 (gensym Tm) (let W2072 (gensym GoTo) (let W2073 (shen.extract-vars (cons (hd (tl (hd V2067))) (hd (tl (tl (hd V2067)))))) (let W2074 (shen.tame (hd V2067)) (let W2075 (shen.extract-vars W2074) (cons let (cons W2071 (cons (cons shen.lazyderef (cons (hd V2068) (cons V2069 ()))) (cons W2072 (cons (shen.goto W2073 (shen.compile-head shen.+m (tl V2067) (tl V2068) V2069 V2070)) (cons (cons if (cons (cons cons? (cons W2071 ())) (cons (shen.compile-head shen.+m (tl (hd V2067)) (cons (cons hd (cons W2071 ())) (cons (cons tl (cons W2071 ())) ())) V2069 (shen.invoke W2072 W2073)) (cons (cons if (cons (cons shen.pvar? (cons W2071 ())) (cons (shen.stpart W2075 (cons shen.bind! (cons W2071 (cons (shen.demode W2074) (cons V2069 (cons (cons freeze (cons (shen.invoke W2072 W2073) ())) ()))))) V2069) (cons false ())))) ())))) ())))))))))))) (true (simple-error "implementation error in shen.cons-case-plus")))) - -(defun shen.demode (V2076) (cond ((and (cons? V2076) (and (= shen.+m (hd V2076)) (and (cons? (tl V2076)) (= () (tl (tl V2076)))))) (shen.demode (hd (tl V2076)))) ((and (cons? V2076) (and (= shen.-m (hd V2076)) (and (cons? (tl V2076)) (= () (tl (tl V2076)))))) (shen.demode (hd (tl V2076)))) ((cons? V2076) (map (lambda Z2077 (shen.demode Z2077)) V2076)) (true V2076))) - -(defun shen.tame (V2078) (cond ((shen.wildcard? V2078) (gensym Y)) ((cons? V2078) (map (lambda Z2079 (shen.tame Z2079)) V2078)) (true V2078))) - -(defun shen.goto (V2080 V2081) (cond ((= () V2080) (cons freeze (cons V2081 ()))) (true (shen.goto-h V2080 V2081)))) - -(defun shen.goto-h (V2082 V2083) (cond ((= () V2082) V2083) ((cons? V2082) (cons lambda (cons (hd V2082) (cons (shen.goto-h (tl V2082) V2083) ())))) (true (shen.f-error shen.goto-h)))) - -(defun shen.invoke (V2084 V2085) (cond ((= () V2085) (cons thaw (cons V2084 ()))) (true (cons V2084 V2085)))) - -(defun shen.wildcard? (V2086) (= V2086 _)) - -(defun shen.pvar? (V2087) (and (absvector? V2087) (= (trap-error (<-address V2087 0) (lambda Z2088 shen.not-pvar)) shen.pvar))) - -(defun shen.lazyderef (V2089 V2090) (if (shen.pvar? V2089) (let W2091 (<-address V2090 (<-address V2089 1)) (if (= W2091 shen.-null-) V2089 (shen.lazyderef W2091 V2090))) V2089)) - -(defun shen.deref (V2092 V2093) (cond ((cons? V2092) (cons (shen.deref (hd V2092) V2093) (shen.deref (tl V2092) V2093))) (true (if (shen.pvar? V2092) (let W2094 (<-address V2093 (<-address V2092 1)) (if (= W2094 shen.-null-) V2092 (shen.deref W2094 V2093))) V2092)))) - -(defun shen.bind! (V2095 V2096 V2097 V2098) (let W2099 (shen.bindv V2095 V2096 V2097) (let W2100 (thaw V2098) (if (= W2100 false) (shen.unwind V2095 V2097 W2100) W2100)))) - -(defun shen.bindv (V2101 V2102 V2103) (address-> V2103 (<-address V2101 1) V2102)) - -(defun shen.unwind (V2104 V2105 V2106) (do (address-> V2105 (<-address V2104 1) shen.-null-) V2106)) - -(defun shen.stpart (V2115 V2116 V2117) (cond ((= () V2115) V2116) ((cons? V2115) (cons let (cons (hd V2115) (cons (cons shen.newpv (cons V2117 ())) (cons (cons shen.gc (cons V2117 (cons (shen.stpart (tl V2115) V2116 V2117) ()))) ()))))) (true (simple-error "implementation error in shen.stpart")))) - -(defun shen.gc (V2118 V2119) (if (= V2119 false) (let W2120 (shen.ticket-number V2118) (do (shen.decrement-ticket W2120 V2118) V2119)) V2119)) - -(defun shen.decrement-ticket (V2121 V2122) (address-> V2122 1 (- V2121 1))) - -(defun shen.newpv (V2123) (let W2124 (shen.ticket-number V2123) (let W2125 (shen.make-prolog-variable W2124) (let W2126 (shen.nextticket V2123 W2124) W2125)))) - -(defun shen.ticket-number (V2127) (<-address V2127 1)) - -(defun shen.nextticket (V2128 V2129) (let W2130 (address-> V2128 V2129 shen.-null-) (address-> W2130 1 (+ V2129 1)))) - -(defun shen.make-prolog-variable (V2131) (address-> (address-> (absvector 2) 0 shen.pvar) 1 V2131)) - -(defun shen.pvar (V2132) (cn "Var" (shen.app (<-address V2132 1) "" shen.a))) - -(defun shen.incinfs () (set shen.*infs* (+ 1 (value shen.*infs*)))) - -(defun shen.lzy=! (V2145 V2146 V2147 V2148) (cond ((= V2145 V2146) (thaw V2148)) ((and (shen.pvar? V2145) (not (shen.occurs-check? V2145 (shen.deref V2146 V2147)))) (shen.bind! V2145 V2146 V2147 V2148)) ((and (shen.pvar? V2146) (not (shen.occurs-check? V2146 (shen.deref V2145 V2147)))) (shen.bind! V2146 V2145 V2147 V2148)) ((and (cons? V2145) (cons? V2146)) (shen.lzy=! (shen.lazyderef (hd V2145) V2147) (shen.lazyderef (hd V2146) V2147) V2147 (freeze (shen.lzy=! (shen.lazyderef (tl V2145) V2147) (shen.lazyderef (tl V2146) V2147) V2147 V2148)))) (true false))) - -(defun shen.lzy= (V2160 V2161 V2162 V2163) (cond ((= V2160 V2161) (thaw V2163)) ((shen.pvar? V2160) (shen.bind! V2160 V2161 V2162 V2163)) ((shen.pvar? V2161) (shen.bind! V2161 V2160 V2162 V2163)) ((and (cons? V2160) (cons? V2161)) (shen.lzy= (shen.lazyderef (hd V2160) V2162) (shen.lazyderef (hd V2161) V2162) V2162 (freeze (shen.lzy= (shen.lazyderef (tl V2160) V2162) (shen.lazyderef (tl V2161) V2162) V2162 V2163)))) (true false))) - -(defun shen.occurs-check? (V2169 V2170) (cond ((= V2169 V2170) true) ((cons? V2170) (or (shen.occurs-check? V2169 (hd V2170)) (shen.occurs-check? V2169 (tl V2170)))) (true false))) - -(defun call (V2171 V2172 V2173 V2174 V2175) ((((V2171 V2172) V2173) V2174) V2175)) - -(defun return (V2182 V2183 V2184 V2185 V2186) (shen.deref V2182 V2183)) - -(defun when (V2193 V2194 V2195 V2196 V2197) (if V2193 (thaw V2197) false)) - -(defun is (V2198 V2199 V2200 V2201 V2202 V2203) (shen.lzy= (shen.lazyderef V2198 V2200) (shen.lazyderef V2199 V2200) V2200 V2203)) - -(defun is! (V2204 V2205 V2206 V2207 V2208 V2209) (shen.lzy=! (shen.lazyderef V2204 V2206) (shen.lazyderef V2205 V2206) V2206 V2209)) - -(defun bind (V2214 V2215 V2216 V2217 V2218 V2219) (shen.bind! V2214 V2215 V2216 V2219)) - -(defun shen.print-prolog-vector (V2227) "|prolog vector|") - -(defun fork (V2246 V2247 V2248 V2249 V2250) (cond ((= () V2246) false) ((cons? V2246) (let W2251 (((((hd V2246) V2247) V2248) V2249) V2250) (if (= W2251 false) (fork (tl V2246) V2247 V2248 V2249 V2250) W2251))) (true (simple-error "fork expects a list of literals -")))) - -(defun shen.f-error (V5790) (do (pr (cn "partial function " (shen.app V5790 "; -" shen.a)) (stoutput)) (do (if (and (not (shen.tracked? V5790)) (y-or-n? (cn "track " (shen.app V5790 "? " shen.a)))) (shen.track-function (ps V5790)) shen.ok) (simple-error "aborted")))) - -(defun shen.tracked? (V5791) (element? V5791 (value shen.*tracking*))) - -(defun shen.track-function (V5796) (cond ((and (cons? V5796) (and (= defun (hd V5796)) (and (cons? (tl V5796)) (and (cons? (tl (tl V5796))) (and (cons? (tl (tl (tl V5796)))) (= () (tl (tl (tl (tl V5796)))))))))) (let W5797 (cons defun (cons (hd (tl V5796)) (cons (hd (tl (tl V5796))) (cons (shen.insert-tracking-code (hd (tl V5796)) (hd (tl (tl V5796))) (hd (tl (tl (tl V5796))))) ())))) (let W5798 (eval-kl W5797) (let W5799 (set shen.*tracking* (adjoin (hd (tl V5796)) (value shen.*tracking*))) (hd (tl V5796)))))) (true (simple-error "implementation error in shen.track-function")))) - -(defun shen.insert-tracking-code (V5800 V5801 V5802) (cons do (cons (cons set (cons shen.*call* (cons (cons + (cons (cons value (cons shen.*call* ())) (cons 1 ()))) ()))) (cons (cons do (cons (cons shen.input-track (cons (cons value (cons shen.*call* ())) (cons V5800 (cons (shen.cons-form (shen.prolog-track V5802 V5801)) ())))) (cons (cons do (cons (cons shen.terpri-or-read-char ()) (cons (cons let (cons Result (cons V5802 (cons (cons do (cons (cons shen.output-track (cons (cons value (cons shen.*call* ())) (cons V5800 (cons Result ())))) (cons (cons do (cons (cons set (cons shen.*call* (cons (cons - (cons (cons value (cons shen.*call* ())) (cons 1 ()))) ()))) (cons (cons do (cons (cons shen.terpri-or-read-char ()) (cons Result ()))) ()))) ()))) ())))) ()))) ()))) ())))) - -(defun shen.prolog-track (V5803 V5804) (cond ((= (occurrences shen.incinfs V5803) 0) V5804) (true (shen.vector-dereference V5804 (shen.vector-parameter V5804))))) - -(defun shen.vector-parameter (V5807) (cond ((= () V5807) ()) ((and (cons? V5807) (and (cons? (tl V5807)) (and (cons? (tl (tl V5807))) (and (cons? (tl (tl (tl V5807)))) (= () (tl (tl (tl (tl V5807))))))))) (hd V5807)) ((cons? V5807) (shen.vector-parameter (tl V5807))) (true (shen.f-error shen.vector-parameter)))) - -(defun shen.vector-dereference (V5810 V5811) (cond ((= () V5811) V5810) ((and (cons? V5810) (and (cons? (tl V5810)) (and (cons? (tl (tl V5810))) (and (cons? (tl (tl (tl V5810)))) (= () (tl (tl (tl (tl V5810))))))))) V5810) ((cons? V5810) (cons (cons shen.deref (cons (hd V5810) (cons V5811 ()))) (shen.vector-dereference (tl V5810) V5811))) (true (shen.f-error shen.vector-dereference)))) - -(defun shen.terpri-or-read-char () (if (value shen.*step*) (shen.check-byte (read-byte (value *stinput*))) (nl 1))) - -(defun shen.check-byte (V5820) (cond ((= 94 V5820) (simple-error "aborted")) (true true))) - -(defun shen.input-track (V5821 V5822 V5823) (do (pr (cn " -" (shen.app (shen.spaces V5821) (cn "<" (shen.app V5821 (cn "> Inputs to " (shen.app V5822 (cn " -" (shen.app (shen.spaces V5821) "" shen.a)) shen.a)) shen.a)) shen.a)) (stoutput)) (shen.recursively-print V5823))) - -(defun shen.recursively-print (V5826) (cond ((= () V5826) (pr " ==>" (stoutput))) ((cons? V5826) (do (print (hd V5826)) (do (pr ", " (stoutput)) (shen.recursively-print (tl V5826))))) (true (simple-error "implementation error in shen.recursively-print")))) - -(defun shen.spaces (V5827) (cond ((= 0 V5827) "") (true (cn " " (shen.spaces (- V5827 1)))))) - -(defun shen.output-track (V5828 V5829 V5830) (pr (cn " -" (shen.app (shen.spaces V5828) (cn "<" (shen.app V5828 (cn "> Output from " (shen.app V5829 (cn " -" (shen.app (shen.spaces V5828) (cn "==> " (shen.app V5830 "" shen.s)) shen.a)) shen.a)) shen.a)) shen.a)) (stoutput))) - -(defun remove (V5833 V5834) (shen.remove-h V5833 V5834 ())) - -(defun shen.remove-h (V5844 V5845 V5846) (cond ((= () V5845) (reverse V5846)) ((and (cons? V5845) (= V5844 (hd V5845))) (shen.remove-h (hd V5845) (tl V5845) V5846)) ((cons? V5845) (shen.remove-h V5844 (tl V5845) (cons (hd V5845) V5846))) (true (simple-error "implementation error in shen.remove-h")))) - -(defun load (V1239) (let W1240 (value shen.*tc*) (let W1241 (let W1242 (get-time run) (let W1243 (shen.load-help W1240 (read-file V1239)) (let W1244 (get-time run) (let W1245 (- W1244 W1242) (let W1246 (pr (cn " -run time: " (cn (str W1245) " secs -")) (stoutput)) W1243))))) (let W1247 (if W1240 (pr (cn " -typechecked in " (shen.app (inferences) " inferences -" shen.a)) (stoutput)) shen.skip) loaded)))) - -(defun shen.load-help (V1250 V1251) (cond ((= false V1250) (shen.eval-and-print V1251)) (true (shen.check-eval-and-print V1251)))) - -(defun shen.eval-and-print (V1252) (shen.for-each (lambda Z1253 (pr (shen.app (eval-kl (shen.shen->kl Z1253)) " -" shen.s) (stoutput))) V1252)) - -(defun shen.check-eval-and-print (V1254) (let W1255 (mapcan (lambda Z1256 (shen.typetable Z1256)) V1254) (let W1257 (trap-error (shen.assumetypes W1255) (lambda Z1258 (shen.unwind-types Z1258 W1255))) (trap-error (shen.work-through V1254) (lambda Z1259 (shen.unwind-types Z1259 W1255)))))) - -(defun shen.typetable (V1264) (cond ((and (cons? V1264) (and (= define (hd V1264)) (and (cons? (tl V1264)) (and (cons? (tl (tl V1264))) (= { (hd (tl (tl V1264)))))))) (cons (hd (tl V1264)) (cons (shen.rectify-type (shen.type-F (hd (tl V1264)) (tl (tl (tl V1264))))) ()))) ((and (cons? V1264) (and (= define (hd V1264)) (cons? (tl V1264)))) (simple-error (cn "missing { in " (shen.app (hd (tl V1264)) " -" shen.a)))) (true ()))) - -(defun shen.type-F (V1271 V1272) (cond ((and (cons? V1272) (= } (hd V1272))) ()) ((cons? V1272) (cons (hd V1272) (shen.type-F V1271 (tl V1272)))) (true (simple-error (cn "missing } in " (shen.app V1271 " -" shen.a)))))) - -(defun shen.assumetypes (V1275) (cond ((= () V1275) ()) ((and (cons? V1275) (cons? (tl V1275))) (do (declare (hd V1275) (hd (tl V1275))) (shen.assumetypes (tl (tl V1275))))) (true (simple-error "implementation error in shen.assumetype")))) - -(defun shen.unwind-types (V1280 V1281) (cond ((and (cons? V1281) (cons? (tl V1281))) (do (destroy (hd V1281)) (shen.unwind-types V1280 (tl (tl V1281))))) (true (simple-error (error-to-string V1280))))) - -(defun shen.work-through (V1284) (cond ((= () V1284) ()) ((and (cons? V1284) (and (cons? (tl V1284)) (and (cons? (tl (tl V1284))) (= (hd (tl V1284)) (intern ":"))))) (let W1285 (shen.typecheck (hd V1284) (hd (tl (tl V1284)))) (if (= W1285 false) (shen.type-error) (let W1286 (eval-kl (shen.shen->kl (hd V1284))) (let W1287 (pr (shen.app W1286 (cn " : " (shen.app (shen.pretty-type W1285) " -" shen.r)) shen.s) (stoutput)) (shen.work-through (tl (tl (tl V1284))))))))) ((cons? V1284) (shen.work-through (cons (hd V1284) (cons (intern ":") (cons A (tl V1284)))))) (true (simple-error "implementation error in shen.work-through")))) - -(defun shen.pretty-type (V1289) (cond ((and (cons? V1289) (and (cons? (hd V1289)) (and (= list (hd (hd V1289))) (and (cons? (tl (hd V1289))) (and (= () (tl (tl (hd V1289)))) (and (cons? (tl V1289)) (and (= --> (hd (tl V1289))) (and (cons? (tl (tl V1289))) (and (cons? (hd (tl (tl V1289)))) (and (= str (hd (hd (tl (tl V1289))))) (and (cons? (tl (hd (tl (tl V1289))))) (and (cons? (hd (tl (hd (tl (tl V1289)))))) (and (= list (hd (hd (tl (hd (tl (tl V1289))))))) (and (cons? (tl (hd (tl (hd (tl (tl V1289))))))) (and (= () (tl (tl (hd (tl (hd (tl (tl V1289)))))))) (and (cons? (tl (tl (hd (tl (tl V1289)))))) (and (= () (tl (tl (tl (hd (tl (tl V1289))))))) (and (= () (tl (tl (tl V1289)))) (= (hd (tl (hd V1289))) (hd (tl (hd (tl (hd (tl (tl V1289)))))))))))))))))))))))))) (cons (hd (tl (hd (tl (tl V1289))))) (cons ==> (tl (tl (hd (tl (tl V1289)))))))) ((cons? V1289) (map (lambda Z1290 (shen.pretty-type Z1290)) V1289)) (true V1289))) - -(defun shen.type-error () (simple-error "type error -")) - -(defun print (V6803) (let W6804 (shen.insert V6803 "~S") (let W6805 (pr W6804 (stoutput)) V6803))) - -(defun pr (V6806 V6807) (if (value *hush*) V6806 (if (shen.char-stoutput? V6807) (shen.write-string V6806 V6807) (shen.write-chars V6806 V6807 (shen.string->byte V6806 0) 1)))) - -(defun shen.string->byte (V6808 V6809) (trap-error (string->n (pos V6808 V6809)) (lambda Z6810 shen.eos))) - -(defun shen.write-chars (V6811 V6812 V6813 V6814) (cond ((= shen.eos V6813) V6811) (true (shen.write-chars V6811 V6812 (do (write-byte V6813 V6812) (shen.string->byte V6811 V6814)) (+ V6814 1))))) - -(defun shen.mkstr (V6815 V6816) (cond ((string? V6815) (shen.mkstr-l (shen.proc-nl V6815) V6816)) (true (shen.mkstr-r (cons shen.proc-nl (cons V6815 ())) V6816)))) - -(defun shen.mkstr-l (V6821 V6822) (cond ((= () V6822) V6821) ((cons? V6822) (shen.mkstr-l (shen.insert-l (hd V6822) V6821) (tl V6822))) (true (simple-error "implementation error in shen.mkstr-l")))) - -(defun shen.insert-l (V6829 V6830) (cond ((= "" V6830) "") ((and (shen.+string? V6830) (and (= "~" (hdstr V6830)) (and (shen.+string? (tlstr V6830)) (= "A" (hdstr (tlstr V6830)))))) (cons shen.app (cons V6829 (cons (tlstr (tlstr V6830)) (cons shen.a ()))))) ((and (shen.+string? V6830) (and (= "~" (hdstr V6830)) (and (shen.+string? (tlstr V6830)) (= "R" (hdstr (tlstr V6830)))))) (cons shen.app (cons V6829 (cons (tlstr (tlstr V6830)) (cons shen.r ()))))) ((and (shen.+string? V6830) (and (= "~" (hdstr V6830)) (and (shen.+string? (tlstr V6830)) (= "S" (hdstr (tlstr V6830)))))) (cons shen.app (cons V6829 (cons (tlstr (tlstr V6830)) (cons shen.s ()))))) ((shen.+string? V6830) (shen.factor-cn (cons cn (cons (hdstr V6830) (cons (shen.insert-l V6829 (tlstr V6830)) ()))))) ((and (cons? V6830) (and (= cn (hd V6830)) (and (cons? (tl V6830)) (and (cons? (tl (tl V6830))) (= () (tl (tl (tl V6830)))))))) (cons cn (cons (hd (tl V6830)) (cons (shen.insert-l V6829 (hd (tl (tl V6830)))) ())))) ((and (cons? V6830) (and (= shen.app (hd V6830)) (and (cons? (tl V6830)) (and (cons? (tl (tl V6830))) (and (cons? (tl (tl (tl V6830)))) (= () (tl (tl (tl (tl V6830)))))))))) (cons shen.app (cons (hd (tl V6830)) (cons (shen.insert-l V6829 (hd (tl (tl V6830)))) (tl (tl (tl V6830))))))) (true (simple-error "implementation error in shen.insert-l")))) - -(defun shen.factor-cn (V6831) (cond ((and (cons? V6831) (and (= cn (hd V6831)) (and (cons? (tl V6831)) (and (cons? (tl (tl V6831))) (and (cons? (hd (tl (tl V6831)))) (and (= cn (hd (hd (tl (tl V6831))))) (and (cons? (tl (hd (tl (tl V6831))))) (and (cons? (tl (tl (hd (tl (tl V6831)))))) (and (= () (tl (tl (tl (hd (tl (tl V6831))))))) (and (= () (tl (tl (tl V6831)))) (and (string? (hd (tl V6831))) (string? (hd (tl (hd (tl (tl V6831))))))))))))))))) (cons cn (cons (cn (hd (tl V6831)) (hd (tl (hd (tl (tl V6831)))))) (tl (tl (hd (tl (tl V6831)))))))) (true V6831))) - -(defun shen.proc-nl (V6834) (cond ((= "" V6834) "") ((and (shen.+string? V6834) (and (= "~" (hdstr V6834)) (and (shen.+string? (tlstr V6834)) (= "%" (hdstr (tlstr V6834)))))) (cn (n->string 10) (shen.proc-nl (tlstr (tlstr V6834))))) ((shen.+string? V6834) (cn (hdstr V6834) (shen.proc-nl (tlstr V6834)))) (true (simple-error "implementation error in shen.proc-nl")))) - -(defun shen.mkstr-r (V6839 V6840) (cond ((= () V6840) V6839) ((cons? V6840) (shen.mkstr-r (cons shen.insert (cons (hd V6840) (cons V6839 ()))) (tl V6840))) (true (simple-error "implementation error in shen.mkstr-r")))) - -(defun shen.insert (V6841 V6842) (shen.insert-h V6841 V6842 "")) - -(defun shen.insert-h (V6851 V6852 V6853) (cond ((= "" V6852) V6853) ((and (shen.+string? V6852) (and (= "~" (hdstr V6852)) (and (shen.+string? (tlstr V6852)) (= "A" (hdstr (tlstr V6852)))))) (cn V6853 (shen.app V6851 (tlstr (tlstr V6852)) shen.a))) ((and (shen.+string? V6852) (and (= "~" (hdstr V6852)) (and (shen.+string? (tlstr V6852)) (= "R" (hdstr (tlstr V6852)))))) (cn V6853 (shen.app V6851 (tlstr (tlstr V6852)) shen.r))) ((and (shen.+string? V6852) (and (= "~" (hdstr V6852)) (and (shen.+string? (tlstr V6852)) (= "S" (hdstr (tlstr V6852)))))) (cn V6853 (shen.app V6851 (tlstr (tlstr V6852)) shen.s))) ((shen.+string? V6852) (shen.insert-h V6851 (tlstr V6852) (cn V6853 (hdstr V6852)))) (true (simple-error "implementation error in shen.insert-h")))) - -(defun shen.app (V6854 V6855 V6856) (cn (shen.arg->str V6854 V6856) V6855)) - -(defun shen.arg->str (V6860 V6861) (cond ((= V6860 (fail)) "...") ((shen.list? V6860) (shen.list->str V6860 V6861)) ((string? V6860) (shen.str->str V6860 V6861)) ((absvector? V6860) (shen.vector->str V6860 V6861)) (true (shen.atom->str V6860)))) - -(defun shen.list->str (V6862 V6863) (cond ((= shen.r V6863) (@s "(" (@s (shen.iter-list V6862 shen.r (shen.maxseq)) ")"))) (true (@s "[" (@s (shen.iter-list V6862 V6863 (shen.maxseq)) "]"))))) - -(defun shen.maxseq () (value *maximum-print-sequence-size*)) - -(defun shen.iter-list (V6874 V6875 V6876) (cond ((= () V6874) "") ((= 0 V6876) "... etc") ((and (cons? V6874) (= () (tl V6874))) (shen.arg->str (hd V6874) V6875)) ((cons? V6874) (@s (shen.arg->str (hd V6874) V6875) (@s " " (shen.iter-list (tl V6874) V6875 (- V6876 1))))) (true (@s "|" (@s " " (shen.arg->str V6874 V6875)))))) - -(defun shen.str->str (V6879 V6880) (cond ((= shen.a V6880) V6879) (true (@s (n->string 34) (@s V6879 (n->string 34)))))) - -(defun shen.vector->str (V6881 V6882) (if (shen.print-vector? V6881) ((fn (<-address V6881 0)) V6881) (if (vector? V6881) (@s "<" (@s (shen.iter-vector V6881 1 V6882 (shen.maxseq)) ">")) (@s "<" (@s "<" (@s (shen.iter-vector V6881 0 V6882 (shen.maxseq)) ">>")))))) - -(defun shen.empty-absvector? (V6883) (= V6883 (value shen.*empty-absvector*))) - -(defun shen.print-vector? (V6884) (and (not (shen.empty-absvector? V6884)) (let W6885 (<-address V6884 0) (or (= W6885 shen.tuple) (or (= W6885 shen.pvar) (or (= W6885 shen.dictionary) (and (not (number? W6885)) (shen.fbound? W6885)))))))) - -(defun shen.fbound? (V6886) (not (= (arity V6886) -1))) - -(defun shen.tuple (V6887) (cn "(@p " (shen.app (<-address V6887 1) (cn " " (shen.app (<-address V6887 2) ")" shen.s)) shen.s))) - -(defun shen.dictionary (V6888) "(dict ...)") - -(defun shen.iter-vector (V6895 V6896 V6897 V6898) (cond ((= 0 V6898) "... etc") (true (let W6899 (trap-error (<-address V6895 V6896) (lambda Z6900 shen.out-of-bounds)) (let W6901 (trap-error (<-address V6895 (+ V6896 1)) (lambda Z6902 shen.out-of-bounds)) (if (= W6899 shen.out-of-bounds) "" (if (= W6901 shen.out-of-bounds) (shen.arg->str W6899 V6897) (@s (shen.arg->str W6899 V6897) (@s " " (shen.iter-vector V6895 (+ V6896 1) V6897 (- V6898 1))))))))))) - -(defun shen.atom->str (V6903) (trap-error (str V6903) (lambda Z6904 (shen.funexstring)))) - -(defun shen.funexstring () (@s "" (@s "f" (@s "u" (@s "n" (@s "e" (@s (shen.arg->str (gensym (intern "x")) shen.a) ""))))))) - -(defun shen.list? (V6905) (or (empty? V6905) (cons? V6905))) - -(defun macroexpand (V6939) (let W6940 (map (lambda Z6941 (tl Z6941)) (value *macros*)) (shen.macroexpand-h V6939 W6940 W6940))) - -(defun shen.macroexpand-h (V6950 V6951 V6952) (if (= () V6951) V6950 (if (cons? V6951) (let W6953 (shen.walk (hd V6951) V6950) (if (= V6950 W6953) (shen.macroexpand-h V6950 (tl V6951) V6952) (shen.macroexpand-h W6953 V6952 V6952))) (simple-error "implementation error in shen.macroexpand-h")))) - -(defun shen.walk (V6954 V6955) (if (cons? V6955) (V6954 (map (lambda Z6956 (shen.walk V6954 Z6956)) V6955)) (V6954 V6955))) - -(defun shen.macros (V6957) (let GoTo6958 (freeze V6957) (if (cons? V6957) (let Select6963 (hd V6957) (let Select6964 (tl V6957) (if (and (= defmacro Select6963) (cons? Select6964)) (shen.process-def (hd Select6964) (tl Select6964)) (if (= defcc Select6963) (shen.yacc->shen Select6964) (if (and (= u! Select6963) (and (cons? Select6964) (= () (tl Select6964)))) (cons protect (cons (shen.make-uppercase (hd Select6964)) ())) (if (and (= error Select6963) (cons? Select6964)) (cons simple-error (cons (shen.mkstr (hd Select6964) (tl Select6964)) ())) (if (and (= output Select6963) (cons? Select6964)) (cons pr (cons (shen.mkstr (hd Select6964) (tl Select6964)) (cons (cons stoutput ()) ()))) (if (and (= pr Select6963) (and (cons? Select6964) (= () (tl Select6964)))) (cons pr (cons (hd Select6964) (cons (cons stoutput ()) ()))) (if (and (= make-string Select6963) (cons? Select6964)) (shen.mkstr (hd Select6964) (tl Select6964)) (if (and (= lineread Select6963) (= () Select6964)) (cons lineread (cons (cons stinput ()) ())) (if (and (= input Select6963) (= () Select6964)) (cons input (cons (cons stinput ()) ())) (if (and (= read Select6963) (= () Select6964)) (cons read (cons (cons stinput ()) ())) (if (and (= input+ Select6963) (and (cons? Select6964) (= () (tl Select6964)))) (cons input+ (cons (hd Select6964) (cons (cons stinput ()) ()))) (if (and (= read-byte Select6963) (= () Select6964)) (shen.process-read-byte) (if (= prolog? Select6963) (shen.call-prolog Select6964) (if (and (= defprolog Select6963) (cons? Select6964)) (shen.compile-prolog (hd Select6964) (tl Select6964)) (if (and (= datatype Select6963) (cons? Select6964)) (shen.process-datatype (hd Select6964) (tl Select6964)) (if (= @s Select6963) (shen.process-@s V6957) (if (= synonyms Select6963) (shen.process-synonyms Select6964) (if (and (= nl Select6963) (= () Select6964)) (cons nl (cons 1 ())) (if (= let Select6963) (shen.process-let V6957) (if (= /. Select6963) (shen.process-lambda V6957) (if (= cases Select6963) (shen.process-cases V6957) (if (and (= time Select6963) (and (cons? Select6964) (= () (tl Select6964)))) (shen.process-time (hd Select6964)) (if (and (= put Select6963) (and (cons? Select6964) (and (cons? (tl Select6964)) (and (cons? (tl (tl Select6964))) (= () (tl (tl (tl Select6964)))))))) (cons put (cons (hd Select6964) (cons (hd (tl Select6964)) (cons (hd (tl (tl Select6964))) (cons (cons value (cons *property-vector* ())) ()))))) (if (and (= get Select6963) (and (cons? Select6964) (and (cons? (tl Select6964)) (= () (tl (tl Select6964)))))) (cons get (cons (hd Select6964) (cons (hd (tl Select6964)) (cons (cons value (cons *property-vector* ())) ())))) (if (and (= unput Select6963) (and (cons? Select6964) (and (cons? (tl Select6964)) (= () (tl (tl Select6964)))))) (cons unput (cons (hd Select6964) (cons (hd (tl Select6964)) (cons (cons value (cons *property-vector* ())) ())))) (if (and (= shen.@c Select6963) (and (cons? Select6964) (= () (tl Select6964)))) (shen.rcons_form (hd Select6964)) (let GoTo6959 (freeze (if (and (cons? Select6964) (and (cons? (tl Select6964)) (and (cons? (tl (tl Select6964))) (element? Select6963 (cons @p (cons @v (cons append (cons and (cons or (cons + (cons * (cons do ())))))))))))) (cons Select6963 (cons (hd Select6964) (cons (shen.process-assoc (cons Select6963 (tl Select6964))) ()))) (thaw GoTo6958))) (if (= shen.@ch Select6963) (if (cons? Select6964) (let Select6961 (hd Select6964) (let Select6962 (tl Select6964) (if (and (cons? Select6961) (and (cons? (tl Select6961)) (and (cons? (tl (tl Select6961))) (and (= () (tl (tl (tl Select6961)))) (and (= () Select6962) (= (hd (tl Select6961)) (intern ":"))))))) (shen.cons-form-respect-modes (cons - (cons (cons (hd Select6961) (cons (hd (tl Select6961)) (cons (cons + (tl (tl Select6961))) ()))) ()))) (if (= () Select6962) (shen.cons-form-respect-modes Select6961) (thaw GoTo6959))))) (thaw GoTo6959)) (thaw GoTo6959))))))))))))))))))))))))))))))) (thaw GoTo6958)))) - -(defun shen.cons-form-respect-modes (V6965) (let GoTo6966 (freeze V6965) (if (cons? V6965) (let Select6967 (hd V6965) (let Select6968 (tl V6965) (if (and (= + Select6967) (and (cons? Select6968) (= () (tl Select6968)))) (cons + (cons (shen.cons-form-respect-modes (hd Select6968)) ())) (if (and (= - Select6967) (and (cons? Select6968) (= () (tl Select6968)))) (cons - (cons (shen.cons-form-respect-modes (hd Select6968)) ())) (cons cons (cons (shen.cons-form-respect-modes Select6967) (cons (shen.cons-form-respect-modes Select6968) ()))))))) (thaw GoTo6966)))) - -(defun shen.process-def (V6969 V6970) (let W6971 (cons X (cons -> (cons X ()))) (let W6972 (eval (cons define (cons V6969 (append V6970 W6971)))) (let W6973 (shen.record-macro V6969 (fn V6969)) V6969)))) - -(defun shen.process-let (V6974) (if (and (cons? V6974) (and (= let (hd V6974)) (and (cons? (tl V6974)) (and (cons? (tl (tl V6974))) (and (cons? (tl (tl (tl V6974)))) (cons? (tl (tl (tl (tl V6974)))))))))) (cons let (cons (hd (tl V6974)) (cons (hd (tl (tl V6974))) (cons (cons let (tl (tl (tl V6974)))) ())))) V6974)) - -(defun shen.process-@s (V6975) (let GoTo6977 (freeze V6975) (if (cons? V6975) (let Select6984 (tl V6975) (if (= @s (hd V6975)) (if (cons? Select6984) (let Select6982 (hd Select6984) (let Select6983 (tl Select6984) (if (cons? Select6983) (let Select6981 (tl Select6983) (if (cons? Select6981) (cons @s (cons Select6982 (cons (shen.process-@s (cons @s Select6983)) ()))) (if (and (= () Select6981) (string? Select6982)) (let W6976 (explode Select6982) (if (> (length W6976) 1) (shen.process-@s (cons @s (append W6976 Select6983))) V6975)) (thaw GoTo6977)))) (thaw GoTo6977)))) (thaw GoTo6977)) (thaw GoTo6977))) (thaw GoTo6977)))) - -(defun shen.process-datatype (V6985 V6986) (let W6987 (shen.intern-type V6985) (let W6988 (compile (lambda Z6989 (shen. Z6989)) (cons W6987 V6986)) W6987))) - -(defun shen.intern-type (V6990) (intern (cn (str V6990) "#type"))) - -(defun shen.process-synonyms (V6991) (shen.synonyms-h (set shen.*synonyms* (append V6991 (value shen.*synonyms*))))) - -(defun shen.lambda-of-defun (V6994) (if (and (cons? V6994) (and (= defun (hd V6994)) (and (cons? (tl V6994)) (and (cons? (tl (tl V6994))) (and (cons? (hd (tl (tl V6994)))) (and (= () (tl (hd (tl (tl V6994))))) (and (cons? (tl (tl (tl V6994)))) (= () (tl (tl (tl (tl V6994)))))))))))) (eval (cons /. (cons (hd (hd (tl (tl V6994)))) (tl (tl (tl V6994)))))) (shen.f-error shen.lambda-of-defun))) - -(defun shen.synonyms-h (V6995) (let W6996 (map (lambda Z6997 (shen.curry-type Z6997)) V6995) (let W6998 (shen.lambda-of-defun (shen.shendef->kldef shen.demod (shen.compile-synonyms W6996))) (let W6999 (set shen.*demodulation-function* W6998) synonyms)))) - -(defun shen.compile-synonyms (V7002) (if (= () V7002) (let W7003 (gensym X) (cons W7003 (cons -> (cons W7003 ())))) (if (and (cons? V7002) (cons? (tl V7002))) (cons (shen.rcons_form (hd V7002)) (cons -> (cons (shen.rcons_form (hd (tl V7002))) (shen.compile-synonyms (tl (tl V7002)))))) (simple-error "synonyms requires an even number of arguments -")))) - -(defun shen.process-lambda (V7004) (let GoTo7005 (freeze V7004) (if (cons? V7004) (let Select7012 (tl V7004) (if (= /. (hd V7004)) (if (cons? Select7012) (let Select7010 (hd Select7012) (let Select7011 (tl Select7012) (if (cons? Select7011) (let Select7009 (tl Select7011) (if (cons? Select7009) (cons lambda (cons Select7010 (cons (shen.process-lambda (cons /. Select7011)) ()))) (if (= () Select7009) (if (variable? Select7010) (cons lambda Select7012) (simple-error (shen.app Select7010 " is not a variable -" shen.s))) (thaw GoTo7005)))) (thaw GoTo7005)))) (thaw GoTo7005)) (thaw GoTo7005))) (thaw GoTo7005)))) - -(defun shen.process-cases (V7015) (let GoTo7016 (freeze V7015) (if (cons? V7015) (let Select7024 (tl V7015) (if (= cases (hd V7015)) (if (cons? Select7024) (let Select7022 (hd Select7024) (let Select7023 (tl Select7024) (if (and (= true Select7022) (cons? Select7023)) (hd Select7023) (let GoTo7019 (freeze (if (= () Select7023) (simple-error "error: odd number of case elements -") (thaw GoTo7016))) (if (cons? Select7023) (let Select7020 (hd Select7023) (let Select7021 (tl Select7023) (if (= () Select7021) (cons if (cons Select7022 (cons Select7020 (cons (cons simple-error (cons "error: cases exhausted" ())) ())))) (cons if (cons Select7022 (cons Select7020 (cons (shen.process-cases (cons cases Select7021)) ()))))))) (thaw GoTo7019)))))) (thaw GoTo7016)) (thaw GoTo7016))) (thaw GoTo7016)))) - -(defun shen.process-time (V7025) (cons let (cons Start (cons (cons get-time (cons run ())) (cons Result (cons V7025 (cons Finish (cons (cons get-time (cons run ())) (cons Time (cons (cons - (cons Finish (cons Start ()))) (cons Message (cons (cons pr (cons (cons cn (cons " -run time: " (cons (cons cn (cons (cons str (cons Time ())) (cons " secs -" ()))) ()))) (cons (cons stoutput ()) ()))) (cons Result ()))))))))))))) - -(defun shen.process-assoc (V7026) (if (and (cons? V7026) (and (cons? (tl V7026)) (and (cons? (tl (tl V7026))) (cons? (tl (tl (tl V7026))))))) (cons (hd V7026) (cons (hd (tl V7026)) (cons (cons (hd V7026) (tl (tl V7026))) ()))) V7026)) - -(defun shen.make-uppercase (V7027) (intern (shen.mu-h (str V7027)))) - -(defun shen.mu-h (V7028) (if (= "" V7028) "" (if (shen.+string? V7028) (let W7029 (string->n (hdstr V7028)) (let W7030 (- W7029 32) (let W7031 (if (and (>= W7029 97) (<= W7029 122)) (n->string W7030) (hdstr V7028)) (@s W7031 (shen.mu-h (tlstr V7028)))))) (shen.f-error shen.mu-h)))) - -(defun shen.record-macro (V7032 V7033) (set *macros* (shen.update-assoc V7032 V7033 (value *macros*)))) - -(defun shen.update-assoc (V7043 V7044 V7045) (if (= () V7045) (cons (cons V7043 V7044) ()) (let GoTo7046 (freeze (simple-error "implementation error in shen.update-assoc")) (if (cons? V7045) (let Select7047 (hd V7045) (let Select7048 (tl V7045) (if (and (cons? Select7047) (= V7043 (hd Select7047))) (cons (cons (hd Select7047) V7044) Select7048) (cons Select7047 (shen.update-assoc V7043 V7044 Select7048))))) (thaw GoTo7046))))) - -(defun shen.process-read-byte () (if (shen.char-stinput? (stinput)) (cons string->n (cons (cons shen.read-unit-string (cons (cons stinput ()) ())) ())) (cons read-byte (cons (cons stinput ()) ())))) - -(defun shen.call-prolog (V7049) (let W7050 (cons shen.prolog-vector ()) (let W7051 (cons @v (cons true (cons 0 (cons (cons vector (cons 0 ())) ())))) (let W7052 0 (let W7053 (cons freeze (cons true ())) (let W7054 (compile (lambda Z7055 (shen. Z7055)) V7049) (let W7056 (shen.received V7049) (let W7057 (gensym V) (let W7058 (gensym L) (let W7059 (gensym K) (let W7060 (gensym C) (let W7061 (cons lambda (cons W7057 (cons (cons lambda (cons W7058 (cons (cons lambda (cons W7059 (cons (cons lambda (cons W7060 (cons (shen.continue W7056 W7054 W7057 W7058 W7059 W7060) ()))) ()))) ()))) ()))) (cons W7061 (cons W7050 (cons W7051 (cons W7052 (cons W7053 ()))))))))))))))))) - -(defun shen.received (V7064) (let GoTo7065 (freeze ()) (if (cons? V7064) (let Select7066 (hd V7064) (let Select7067 (tl V7064) (if (and (= receive Select7066) (and (cons? Select7067) (= () (tl Select7067)))) Select7067 (union (shen.received Select7066) (shen.received Select7067))))) (thaw GoTo7065)))) - -(defun shen.prolog-vector () (let W7068 (absvector (value shen.*prolog-memory*)) (let W7069 (address-> W7068 0 shen.print-prolog-vector) (let W7070 (address-> W7068 1 2) W7070)))) - -(defun receive (V7071) V7071) - -(defun shen.rcons_form (V7072) (if (cons? V7072) (cons cons (cons (shen.rcons_form (hd V7072)) (cons (shen.rcons_form (tl V7072)) ()))) V7072)) - -(defun prolog-memory (V910) (if (< V910 0) (value shen.*prolog-memory*) (if (integer? V910) (set shen.*prolog-memory* V910) (simple-error "prolog memory expects an integer value -")))) - -(defun arity (V911) (trap-error (get V911 arity (value *property-vector*)) (lambda Z912 -1))) - -(defun shen.initialise-arity-table (V915) (cond ((= () V915) ()) ((and (cons? V915) (cons? (tl V915))) (let W916 (put (hd V915) arity (hd (tl V915)) (value *property-vector*)) (shen.initialise-arity-table (tl (tl V915))))) (true (simple-error "implementation error in shen.initialise-arity-table")))) - -(defun adjoin (V920 V921) (if (element? V920 V921) V921 (cons V920 V921))) - -(defun shen.set-lambda-form-entry (V924) (cond ((cons? V924) (put (hd V924) shen.lambda-form (tl V924) (value *property-vector*))) (true (shen.f-error shen.set-lambda-form-entry)))) - -(defun declare (V5907 V5908) (let W5909 (shen.rectify-type V5908) (let W5910 (((((lambda Z5911 (lambda Z5912 (lambda Z5913 (lambda Z5914 (do (shen.incinfs) (shen.variancy (receive (shen.deref V5907 Z5911)) (receive (shen.deref W5909 Z5911)) Z5911 Z5912 Z5913 Z5914)))))) (shen.prolog-vector)) (@v true (@v 0 (vector 0)))) 0) (freeze true)) (let W5915 (eval-kl (shen.prolog-abstraction V5908)) (let W5916 (set shen.*sigf* (shen.assoc-> V5907 W5915 (value shen.*sigf*))) V5907))))) - -(defun shen.variancy (V5917 V5918 V5919 V5920 V5921 V5922) (if (shen.unlocked? V5920) (let W5923 (shen.newpv V5919) (shen.gc V5919 (do (shen.incinfs) (shen.system-S-h V5917 W5923 () V5919 V5920 V5921 (freeze (shen.variants? V5917 W5923 V5918 V5919 V5920 V5921 V5922)))))) false)) - -(defun shen.variants? (V5924 V5925 V5926 V5927 V5928 V5929 V5930) (let W5931 (+ V5929 1) (let W5932 (if (shen.unlocked? V5928) (let W5933 (shen.lazyderef V5925 V5927) (let W5934 (freeze (do (shen.incinfs) (shen.cut V5927 V5928 W5931 V5930))) (if (= W5933 symbol) (thaw W5934) (if (shen.pvar? W5933) (shen.bind! W5933 symbol V5927 W5934) false)))) false) (if (= W5932 false) (let W5935 (if (shen.unlocked? V5928) (do (shen.incinfs) (is! V5925 V5926 V5927 V5928 W5931 V5930)) false) (if (= W5935 false) (let W5936 (if (shen.unlocked? V5928) (let W5937 (shen.newpv V5927) (shen.gc V5927 (do (shen.incinfs) (is W5937 (pr (cn "warning: changing the type of " (shen.app (shen.deref V5924 V5927) " may create errors -" shen.a)) (stoutput)) V5927 V5928 W5931 V5930)))) false) (if (= W5936 false) (shen.unlock V5928 W5931) W5936)) W5935)) W5932)))) - -(defun shen.prolog-abstraction (V5938) (let W5939 (gensym B) (let W5940 (gensym L) (let W5941 (gensym Key) (let W5942 (gensym C) (let W5943 (gensym V) (let W5944 (shen.extract-vars V5938) (cons lambda (cons W5943 (cons (cons lambda (cons W5939 (cons (cons lambda (cons W5940 (cons (cons lambda (cons W5941 (cons (cons lambda (cons W5942 (cons (shen.stpart W5944 (cons is! (cons W5943 (cons (shen.rcons_form V5938) (cons W5939 (cons W5940 (cons W5941 (cons W5942 ()))))))) W5939) ()))) ()))) ()))) ()))) ())))))))))) - -(defun shen.demod (V5945) (let W5946 (value shen.*demodulation-function*) (W5946 V5945))) - -(defun shen.typecheck (V4853 V4854) (let W4855 (shen.extract-vars V4854) (let W4856 (shen.rectify-type V4854) (let W4857 (shen.curry V4853) (((((lambda Z4858 (lambda Z4859 (lambda Z4860 (lambda Z4861 (let W4862 (shen.newpv Z4858) (shen.gc Z4858 (do (shen.incinfs) (shen.insert-prolog-variables (receive (shen.deref W4855 Z4858)) (receive (shen.deref W4856 Z4858)) W4862 Z4858 Z4859 Z4860 (freeze (shen.toplevel-forms (receive (shen.deref W4857 Z4858)) W4862 Z4858 Z4859 Z4860 (freeze (return W4862 Z4858 Z4859 Z4860 Z4861)))))))))))) (shen.prolog-vector)) (@v true (@v 0 (vector 0)))) 0) (freeze true)))))) - -(defun shen.insert-prolog-variables (V4863 V4864 V4865 V4866 V4867 V4868 V4869) (let W4870 (if (shen.unlocked? V4867) (let W4871 (shen.lazyderef V4863 V4866) (if (= W4871 ()) (do (shen.incinfs) (is! V4864 V4865 V4866 V4867 V4868 V4869)) false)) false) (if (= W4870 false) (if (shen.unlocked? V4867) (let W4872 (shen.lazyderef V4863 V4866) (if (cons? W4872) (let W4873 (hd W4872) (let W4874 (tl W4872) (let W4875 (shen.newpv V4866) (shen.gc V4866 (do (shen.incinfs) (shen.insert-prolog-variables W4874 (subst (shen.deref W4875 V4866) W4873 V4864) V4865 V4866 V4867 V4868 V4869)))))) false)) false) W4870))) - -(defun shen.toplevel-forms (V4876 V4877 V4878 V4879 V4880 V4881) (let W4882 (+ V4880 1) (let W4883 (if (shen.unlocked? V4879) (let W4884 (shen.lazyderef V4876 V4878) (if (cons? W4884) (let W4885 (shen.lazyderef (hd W4884) V4878) (if (= W4885 define) (let W4886 (shen.lazyderef (tl W4884) V4878) (if (cons? W4886) (let W4887 (hd W4886) (let W4888 (tl W4886) (do (shen.incinfs) (when (shen.type-theory-enabled?) V4878 V4879 W4882 (freeze (shen.cut V4878 V4879 W4882 (freeze (shen.signal-def (value shen.*spy*) W4887 V4878 V4879 W4882 (freeze (shen.t* (cons define (cons W4887 W4888)) V4877 V4878 V4879 W4882 V4881)))))))))) false)) false)) false)) false) (if (= W4883 false) (let W4889 (if (shen.unlocked? V4879) (do (shen.incinfs) (shen.system-S (cons V4876 (cons (intern ":") (cons V4877 ()))) () V4878 V4879 W4882 V4881)) false) (if (= W4889 false) (shen.unlock V4879 W4882) W4889)) W4883)))) - -(defun shen.signal-def (V4890 V4891 V4892 V4893 V4894 V4895) (let W4896 (if (shen.unlocked? V4893) (let W4897 (shen.lazyderef V4890 V4892) (if (= W4897 false) (do (shen.incinfs) (thaw V4895)) false)) false) (if (= W4896 false) (if (shen.unlocked? V4893) (let W4898 (shen.lazyderef V4890 V4892) (if (= W4898 true) (let W4899 (shen.newpv V4892) (shen.gc V4892 (do (shen.incinfs) (is W4899 (pr (cn " -typechecking (fn " (shen.app (shen.deref V4891 V4892) ") -" shen.a)) (stoutput)) V4892 V4893 V4894 V4895)))) false)) false) W4896))) - -(defun shen.rectify-type (V4900) (shen.demodulate (shen.curry-type V4900))) - -(defun shen.demodulate (V4901) (trap-error (let W4902 (shen.walk (lambda Z4903 (shen.demod Z4903)) V4901) (if (= W4902 V4901) V4901 (shen.demodulate W4902))) (lambda Z4904 V4901))) - -(defun shen.curry-type (V4905) (cond ((and (cons? V4905) (and (cons? (tl V4905)) (and (= --> (hd (tl V4905))) (and (cons? (tl (tl V4905))) (and (cons? (tl (tl (tl V4905)))) (= --> (hd (tl (tl (tl V4905)))))))))) (shen.curry-type (cons (hd V4905) (cons --> (cons (tl (tl V4905)) ()))))) ((and (cons? V4905) (and (cons? (hd V4905)) (and (= list (hd (hd V4905))) (and (cons? (tl (hd V4905))) (and (= () (tl (tl (hd V4905)))) (and (cons? (tl V4905)) (and (= ==> (hd (tl V4905))) (and (cons? (tl (tl V4905))) (= () (tl (tl (tl V4905)))))))))))) (shen.curry-type (cons (hd V4905) (cons --> (cons (cons str (cons (hd V4905) (tl (tl V4905)))) ()))))) ((and (cons? V4905) (and (cons? (tl V4905)) (and (= * (hd (tl V4905))) (and (cons? (tl (tl V4905))) (and (cons? (tl (tl (tl V4905)))) (= * (hd (tl (tl (tl V4905)))))))))) (shen.curry-type (cons (hd V4905) (cons * (cons (tl (tl V4905)) ()))))) ((cons? V4905) (map (lambda Z4906 (shen.curry-type Z4906)) V4905)) (true V4905))) - -(defun shen.curry (V4907) (cond ((and (cons? V4907) (and (= define (hd V4907)) (cons? (tl V4907)))) V4907) ((and (cons? V4907) (and (= type (hd V4907)) (and (cons? (tl V4907)) (and (cons? (tl (tl V4907))) (= () (tl (tl (tl V4907)))))))) (cons type (cons (shen.curry (hd (tl V4907))) (tl (tl V4907))))) ((and (cons? V4907) (and (= input+ (hd V4907)) (and (cons? (tl V4907)) (and (cons? (tl (tl V4907))) (= () (tl (tl (tl V4907)))))))) (cons input+ (cons (hd (tl V4907)) (cons (shen.curry (hd (tl (tl V4907)))) ())))) ((and (cons? V4907) (shen.special? (hd V4907))) (cons (hd V4907) (map (lambda Z4908 (shen.curry Z4908)) (tl V4907)))) ((and (cons? V4907) (shen.extraspecial? (hd V4907))) V4907) ((and (cons? V4907) (and (cons? (tl V4907)) (cons? (tl (tl V4907))))) (shen.curry (cons (cons (hd V4907) (cons (hd (tl V4907)) ())) (tl (tl V4907))))) ((and (cons? V4907) (and (cons? (tl V4907)) (= () (tl (tl V4907))))) (cons (shen.curry (hd V4907)) (cons (shen.curry (hd (tl V4907))) ()))) (true V4907))) - -(defun shen.special? (V4909) (element? V4909 (value shen.*special*))) - -(defun shen.extraspecial? (V4910) (element? V4910 (value shen.*extraspecial*))) - -(defun shen.system-S (V4911 V4912 V4913 V4914 V4915 V4916) (let W4917 (+ V4915 1) (let W4918 (if (shen.unlocked? V4914) (do (shen.incinfs) (when (shen.maxinfexceeded?) V4913 V4914 W4917 V4916)) false) (if (= W4918 false) (let W4919 (if (shen.unlocked? V4914) (let W4920 (shen.lazyderef V4911 V4913) (if (cons? W4920) (let W4921 (hd W4920) (let W4922 (shen.lazyderef (tl W4920) V4913) (if (cons? W4922) (let W4923 (hd W4922) (let W4924 (shen.lazyderef (tl W4922) V4913) (if (cons? W4924) (let W4925 (hd W4924) (let W4926 (shen.lazyderef (tl W4924) V4913) (if (= W4926 ()) (do (shen.incinfs) (when (= (shen.deref W4923 V4913) (intern ":")) V4913 V4914 W4917 (freeze (when (shen.type-theory-enabled?) V4913 V4914 W4917 (freeze (shen.cut V4913 V4914 W4917 (freeze (shen.system-S-h W4921 W4925 V4912 V4913 V4914 W4917 V4916)))))))) false))) false))) false))) false)) false) (if (= W4919 false) (let W4927 (if (shen.unlocked? V4914) (do (shen.incinfs) (when (value shen.*spy*) V4913 V4914 W4917 (freeze (shen.show V4911 V4912 V4913 V4914 W4917 V4916)))) false) (if (= W4927 false) (let W4928 (if (shen.unlocked? V4914) (do (shen.incinfs) (shen.search-user-datatypes V4911 V4912 (value shen.*datatypes*) V4913 V4914 W4917 V4916)) false) (if (= W4928 false) (shen.unlock V4914 W4917) W4928)) W4927)) W4919)) W4918)))) - -(defun shen.show (V4935 V4936 V4937 V4938 V4939 V4940) (do (shen.line) (do (shen.show-p (shen.deref V4935 V4937)) (do (nl 2) (do (shen.show-assumptions (shen.deref V4936 V4937) 1) (do (shen.pause-for-user) false)))))) - -(defun shen.line () (let W4941 (inferences) (pr (cn "____________________________________________________________ " (shen.app W4941 (cn " inference" (shen.app (if (= 1 W4941) "" "s") " -?- " shen.a)) shen.a)) (stoutput)))) - -(defun shen.show-p (V4942) (cond ((and (cons? V4942) (and (cons? (tl V4942)) (and (cons? (tl (tl V4942))) (and (= () (tl (tl (tl V4942)))) (= (hd (tl V4942)) (intern ":")))))) (do (shen.prterm (hd V4942)) (do (pr " : " (stoutput)) (pr (shen.app (hd (tl (tl V4942))) "" shen.r) (stoutput))))) (true (shen.prterm V4942)))) - -(defun shen.prterm (V4943) (cond ((and (cons? V4943) (and (= cons (hd V4943)) (and (cons? (tl V4943)) (and (cons? (tl (tl V4943))) (= () (tl (tl (tl V4943)))))))) (do (pr "[" (stoutput)) (do (shen.prterm (hd (tl V4943))) (do (shen.prtl (hd (tl (tl V4943)))) (pr "]" (stoutput)))))) ((cons? V4943) (do (pr "(" (stoutput)) (do (shen.prterm (hd V4943)) (do (map (lambda Z4944 (do (pr " " (stoutput)) (shen.prterm Z4944))) (tl V4943)) (pr ")" (stoutput)))))) (true (print V4943)))) - -(defun shen.prtl (V4945) (cond ((= () V4945) "") ((and (cons? V4945) (and (= cons (hd V4945)) (and (cons? (tl V4945)) (and (cons? (tl (tl V4945))) (= () (tl (tl (tl V4945)))))))) (do (pr " " (stoutput)) (do (shen.prterm (hd (tl V4945))) (shen.prtl (hd (tl (tl V4945))))))) (true (do (pr " | " (stoutput)) (shen.prterm V4945))))) - -(defun shen.show-assumptions (V4952 V4953) (cond ((= () V4952) (pr " -> " (stoutput))) ((cons? V4952) (do (pr (shen.app V4953 ". " shen.a) (stoutput)) (do (shen.show-p (hd V4952)) (do (nl 1) (shen.show-assumptions (tl V4952) (+ V4953 1)))))) (true (simple-error "implementation error in shen.show-assumptions")))) - -(defun shen.pause-for-user () (let W4954 (read-byte (stinput)) (if (= W4954 94) (simple-error "input aborted -") (nl 1)))) - -(defun shen.type-theory-enabled? () (value shen.*shen-type-theory-enabled?*)) - -(defun shen.maxinfexceeded? () (if (> (inferences) (value shen.*maxinferences*)) (simple-error "maximum inferences exceeded") false)) - -(defun shen.system-S-h (V4955 V4956 V4957 V4958 V4959 V4960 V4961) (let W4962 (+ V4960 1) (let W4963 (if (shen.unlocked? V4959) (do (shen.incinfs) (when (value shen.*spy*) V4958 V4959 W4962 (freeze (shen.show (cons V4955 (cons (intern ":") (cons V4956 ()))) V4957 V4958 V4959 W4962 V4961)))) false) (if (= W4963 false) (let W4964 (if (shen.unlocked? V4959) (do (shen.incinfs) (when (not (cons? (shen.lazyderef V4955 V4958))) V4958 V4959 W4962 (freeze (shen.primitive V4955 V4956 V4958 V4959 W4962 V4961)))) false) (if (= W4964 false) (let W4965 (if (shen.unlocked? V4959) (do (shen.incinfs) (shen.by-hypothesis V4955 V4956 V4957 V4958 V4959 W4962 V4961)) false) (if (= W4965 false) (let W4966 (if (shen.unlocked? V4959) (let W4967 (shen.lazyderef V4955 V4958) (if (cons? W4967) (let W4968 (hd W4967) (let W4969 (shen.lazyderef (tl W4967) V4958) (if (= W4969 ()) (do (shen.incinfs) (shen.lookupsig W4968 (cons --> (cons V4956 ())) V4958 V4959 W4962 V4961)) false))) false)) false) (if (= W4966 false) (let W4970 (if (shen.unlocked? V4959) (let W4971 (shen.lazyderef V4955 V4958) (if (cons? W4971) (let W4972 (shen.lazyderef (hd W4971) V4958) (if (= W4972 fn) (let W4973 (shen.lazyderef (tl W4971) V4958) (if (cons? W4973) (let W4974 (hd W4973) (let W4975 (shen.lazyderef (tl W4973) V4958) (if (= W4975 ()) (do (shen.incinfs) (when (= (arity (shen.deref W4974 V4958)) 0) V4958 V4959 W4962 (freeze (shen.cut V4958 V4959 W4962 (freeze (shen.system-S-h (cons W4974 ()) V4956 V4957 V4958 V4959 W4962 V4961)))))) false))) false)) false)) false)) false) (if (= W4970 false) (let W4976 (if (shen.unlocked? V4959) (let W4977 (shen.lazyderef V4955 V4958) (if (cons? W4977) (let W4978 (shen.lazyderef (hd W4977) V4958) (if (= W4978 fn) (let W4979 (shen.lazyderef (tl W4977) V4958) (if (cons? W4979) (let W4980 (hd W4979) (let W4981 (shen.lazyderef (tl W4979) V4958) (if (= W4981 ()) (do (shen.incinfs) (shen.lookupsig W4980 V4956 V4958 V4959 W4962 V4961)) false))) false)) false)) false)) false) (if (= W4976 false) (let W4982 (if (shen.unlocked? V4959) (let W4983 (shen.lazyderef V4955 V4958) (if (cons? W4983) (let W4984 (hd W4983) (let W4985 (shen.lazyderef (tl W4983) V4958) (if (cons? W4985) (let W4986 (hd W4985) (let W4987 (shen.lazyderef (tl W4985) V4958) (if (= W4987 ()) (let W4988 (shen.newpv V4958) (shen.gc V4958 (do (shen.incinfs) (when (not (cons? (shen.lazyderef W4984 V4958))) V4958 V4959 W4962 (freeze (shen.lookupsig W4984 (cons W4988 (cons --> (cons V4956 ()))) V4958 V4959 W4962 (freeze (shen.system-S-h W4986 W4988 V4957 V4958 V4959 W4962 V4961)))))))) false))) false))) false)) false) (if (= W4982 false) (let W4989 (if (shen.unlocked? V4959) (let W4990 (shen.lazyderef V4955 V4958) (if (cons? W4990) (let W4991 (hd W4990) (let W4992 (shen.lazyderef (tl W4990) V4958) (if (cons? W4992) (let W4993 (hd W4992) (let W4994 (shen.lazyderef (tl W4992) V4958) (if (= W4994 ()) (let W4995 (shen.newpv V4958) (shen.gc V4958 (do (shen.incinfs) (shen.system-S-h W4991 (cons W4995 (cons --> (cons V4956 ()))) V4957 V4958 V4959 W4962 (freeze (shen.system-S-h W4993 W4995 V4957 V4958 V4959 W4962 V4961)))))) false))) false))) false)) false) (if (= W4989 false) (let W4996 (if (shen.unlocked? V4959) (let W4997 (shen.lazyderef V4955 V4958) (if (cons? W4997) (let W4998 (shen.lazyderef (hd W4997) V4958) (if (= W4998 cons) (let W4999 (shen.lazyderef (tl W4997) V4958) (if (cons? W4999) (let W5000 (hd W4999) (let W5001 (shen.lazyderef (tl W4999) V4958) (if (cons? W5001) (let W5002 (hd W5001) (let W5003 (shen.lazyderef (tl W5001) V4958) (if (= W5003 ()) (let W5004 (shen.lazyderef V4956 V4958) (let W5005 (lambda Z5006 (do (shen.incinfs) (shen.system-S-h W5000 Z5006 V4957 V4958 V4959 W4962 (freeze (shen.system-S-h W5002 (cons list (cons Z5006 ())) V4957 V4958 V4959 W4962 V4961))))) (if (cons? W5004) (let W5007 (shen.lazyderef (hd W5004) V4958) (let W5008 (freeze (let W5009 (shen.lazyderef (tl W5004) V4958) (let W5010 (lambda Z5011 (W5005 Z5011)) (if (cons? W5009) (let W5012 (hd W5009) (let W5013 (shen.lazyderef (tl W5009) V4958) (let W5014 (freeze (W5010 W5012)) (if (= W5013 ()) (thaw W5014) (if (shen.pvar? W5013) (shen.bind! W5013 () V4958 W5014) false))))) (if (shen.pvar? W5009) (let W5015 (shen.newpv V4958) (shen.gc V4958 (shen.bind! W5009 (cons W5015 ()) V4958 (freeze (W5010 W5015))))) false))))) (if (= W5007 list) (thaw W5008) (if (shen.pvar? W5007) (shen.bind! W5007 list V4958 W5008) false)))) (if (shen.pvar? W5004) (let W5016 (shen.newpv V4958) (shen.gc V4958 (shen.bind! W5004 (cons list (cons W5016 ())) V4958 (freeze (W5005 W5016))))) false)))) false))) false))) false)) false)) false)) false) (if (= W4996 false) (let W5017 (if (shen.unlocked? V4959) (let W5018 (shen.lazyderef V4955 V4958) (if (cons? W5018) (let W5019 (shen.lazyderef (hd W5018) V4958) (if (= W5019 @p) (let W5020 (shen.lazyderef (tl W5018) V4958) (if (cons? W5020) (let W5021 (hd W5020) (let W5022 (shen.lazyderef (tl W5020) V4958) (if (cons? W5022) (let W5023 (hd W5022) (let W5024 (shen.lazyderef (tl W5022) V4958) (if (= W5024 ()) (let W5025 (shen.lazyderef V4956 V4958) (let W5026 (lambda Z5027 (lambda Z5028 (do (shen.incinfs) (shen.system-S-h W5021 Z5027 V4957 V4958 V4959 W4962 (freeze (shen.system-S-h W5023 Z5028 V4957 V4958 V4959 W4962 V4961)))))) (if (cons? W5025) (let W5029 (hd W5025) (let W5030 (shen.lazyderef (tl W5025) V4958) (let W5031 (lambda Z5032 ((W5026 W5029) Z5032)) (if (cons? W5030) (let W5033 (shen.lazyderef (hd W5030) V4958) (let W5034 (freeze (let W5035 (shen.lazyderef (tl W5030) V4958) (let W5036 (lambda Z5037 (W5031 Z5037)) (if (cons? W5035) (let W5038 (hd W5035) (let W5039 (shen.lazyderef (tl W5035) V4958) (let W5040 (freeze (W5036 W5038)) (if (= W5039 ()) (thaw W5040) (if (shen.pvar? W5039) (shen.bind! W5039 () V4958 W5040) false))))) (if (shen.pvar? W5035) (let W5041 (shen.newpv V4958) (shen.gc V4958 (shen.bind! W5035 (cons W5041 ()) V4958 (freeze (W5036 W5041))))) false))))) (if (= W5033 *) (thaw W5034) (if (shen.pvar? W5033) (shen.bind! W5033 * V4958 W5034) false)))) (if (shen.pvar? W5030) (let W5042 (shen.newpv V4958) (shen.gc V4958 (shen.bind! W5030 (cons * (cons W5042 ())) V4958 (freeze (W5031 W5042))))) false))))) (if (shen.pvar? W5025) (let W5043 (shen.newpv V4958) (shen.gc V4958 (let W5044 (shen.newpv V4958) (shen.gc V4958 (shen.bind! W5025 (cons W5043 (cons * (cons W5044 ()))) V4958 (freeze ((W5026 W5043) W5044))))))) false)))) false))) false))) false)) false)) false)) false) (if (= W5017 false) (let W5045 (if (shen.unlocked? V4959) (let W5046 (shen.lazyderef V4955 V4958) (if (cons? W5046) (let W5047 (shen.lazyderef (hd W5046) V4958) (if (= W5047 @v) (let W5048 (shen.lazyderef (tl W5046) V4958) (if (cons? W5048) (let W5049 (hd W5048) (let W5050 (shen.lazyderef (tl W5048) V4958) (if (cons? W5050) (let W5051 (hd W5050) (let W5052 (shen.lazyderef (tl W5050) V4958) (if (= W5052 ()) (let W5053 (shen.lazyderef V4956 V4958) (let W5054 (lambda Z5055 (do (shen.incinfs) (shen.system-S-h W5049 Z5055 V4957 V4958 V4959 W4962 (freeze (shen.system-S-h W5051 (cons vector (cons Z5055 ())) V4957 V4958 V4959 W4962 V4961))))) (if (cons? W5053) (let W5056 (shen.lazyderef (hd W5053) V4958) (let W5057 (freeze (let W5058 (shen.lazyderef (tl W5053) V4958) (let W5059 (lambda Z5060 (W5054 Z5060)) (if (cons? W5058) (let W5061 (hd W5058) (let W5062 (shen.lazyderef (tl W5058) V4958) (let W5063 (freeze (W5059 W5061)) (if (= W5062 ()) (thaw W5063) (if (shen.pvar? W5062) (shen.bind! W5062 () V4958 W5063) false))))) (if (shen.pvar? W5058) (let W5064 (shen.newpv V4958) (shen.gc V4958 (shen.bind! W5058 (cons W5064 ()) V4958 (freeze (W5059 W5064))))) false))))) (if (= W5056 vector) (thaw W5057) (if (shen.pvar? W5056) (shen.bind! W5056 vector V4958 W5057) false)))) (if (shen.pvar? W5053) (let W5065 (shen.newpv V4958) (shen.gc V4958 (shen.bind! W5053 (cons vector (cons W5065 ())) V4958 (freeze (W5054 W5065))))) false)))) false))) false))) false)) false)) false)) false) (if (= W5045 false) (let W5066 (if (shen.unlocked? V4959) (let W5067 (shen.lazyderef V4955 V4958) (if (cons? W5067) (let W5068 (shen.lazyderef (hd W5067) V4958) (if (= W5068 @s) (let W5069 (shen.lazyderef (tl W5067) V4958) (if (cons? W5069) (let W5070 (hd W5069) (let W5071 (shen.lazyderef (tl W5069) V4958) (if (cons? W5071) (let W5072 (hd W5071) (let W5073 (shen.lazyderef (tl W5071) V4958) (if (= W5073 ()) (let W5074 (shen.lazyderef V4956 V4958) (let W5075 (freeze (do (shen.incinfs) (shen.system-S-h W5070 string V4957 V4958 V4959 W4962 (freeze (shen.system-S-h W5072 string V4957 V4958 V4959 W4962 V4961))))) (if (= W5074 string) (thaw W5075) (if (shen.pvar? W5074) (shen.bind! W5074 string V4958 W5075) false)))) false))) false))) false)) false)) false)) false) (if (= W5066 false) (let W5076 (if (shen.unlocked? V4959) (let W5077 (shen.lazyderef V4955 V4958) (if (cons? W5077) (let W5078 (shen.lazyderef (hd W5077) V4958) (if (= W5078 lambda) (let W5079 (shen.lazyderef (tl W5077) V4958) (if (cons? W5079) (let W5080 (hd W5079) (let W5081 (shen.lazyderef (tl W5079) V4958) (if (cons? W5081) (let W5082 (hd W5081) (let W5083 (shen.lazyderef (tl W5081) V4958) (if (= W5083 ()) (let W5084 (shen.lazyderef V4956 V4958) (let W5085 (lambda Z5086 (lambda Z5087 (let W5088 (shen.newpv V4958) (shen.gc V4958 (let W5089 (shen.newpv V4958) (shen.gc V4958 (do (shen.incinfs) (bind W5089 (shen.freshterm (shen.lazyderef W5080 V4958)) V4958 V4959 W4962 (freeze (bind W5088 (shen.beta (shen.lazyderef W5080 V4958) (shen.deref W5089 V4958) (shen.deref W5082 V4958)) V4958 V4959 W4962 (freeze (shen.system-S-h W5088 Z5087 (cons (cons W5089 (cons (intern ":") (cons Z5086 ()))) V4957) V4958 V4959 W4962 V4961)))))))))))) (if (cons? W5084) (let W5090 (hd W5084) (let W5091 (shen.lazyderef (tl W5084) V4958) (let W5092 (lambda Z5093 ((W5085 W5090) Z5093)) (if (cons? W5091) (let W5094 (shen.lazyderef (hd W5091) V4958) (let W5095 (freeze (let W5096 (shen.lazyderef (tl W5091) V4958) (let W5097 (lambda Z5098 (W5092 Z5098)) (if (cons? W5096) (let W5099 (hd W5096) (let W5100 (shen.lazyderef (tl W5096) V4958) (let W5101 (freeze (W5097 W5099)) (if (= W5100 ()) (thaw W5101) (if (shen.pvar? W5100) (shen.bind! W5100 () V4958 W5101) false))))) (if (shen.pvar? W5096) (let W5102 (shen.newpv V4958) (shen.gc V4958 (shen.bind! W5096 (cons W5102 ()) V4958 (freeze (W5097 W5102))))) false))))) (if (= W5094 -->) (thaw W5095) (if (shen.pvar? W5094) (shen.bind! W5094 --> V4958 W5095) false)))) (if (shen.pvar? W5091) (let W5103 (shen.newpv V4958) (shen.gc V4958 (shen.bind! W5091 (cons --> (cons W5103 ())) V4958 (freeze (W5092 W5103))))) false))))) (if (shen.pvar? W5084) (let W5104 (shen.newpv V4958) (shen.gc V4958 (let W5105 (shen.newpv V4958) (shen.gc V4958 (shen.bind! W5084 (cons W5104 (cons --> (cons W5105 ()))) V4958 (freeze ((W5085 W5104) W5105))))))) false)))) false))) false))) false)) false)) false)) false) (if (= W5076 false) (let W5106 (if (shen.unlocked? V4959) (let W5107 (shen.lazyderef V4955 V4958) (if (cons? W5107) (let W5108 (shen.lazyderef (hd W5107) V4958) (if (= W5108 let) (let W5109 (shen.lazyderef (tl W5107) V4958) (if (cons? W5109) (let W5110 (hd W5109) (let W5111 (shen.lazyderef (tl W5109) V4958) (if (cons? W5111) (let W5112 (hd W5111) (let W5113 (shen.lazyderef (tl W5111) V4958) (if (cons? W5113) (let W5114 (hd W5113) (let W5115 (shen.lazyderef (tl W5113) V4958) (if (= W5115 ()) (let W5116 (shen.newpv V4958) (shen.gc V4958 (let W5117 (shen.newpv V4958) (shen.gc V4958 (let W5118 (shen.newpv V4958) (shen.gc V4958 (do (shen.incinfs) (shen.system-S-h W5112 W5118 V4957 V4958 V4959 W4962 (freeze (bind W5117 (shen.freshterm (shen.lazyderef W5110 V4958)) V4958 V4959 W4962 (freeze (bind W5116 (shen.beta (shen.lazyderef W5110 V4958) (shen.lazyderef W5117 V4958) (shen.lazyderef W5114 V4958)) V4958 V4959 W4962 (freeze (shen.system-S-h W5116 V4956 (cons (cons W5117 (cons (intern ":") (cons W5118 ()))) V4957) V4958 V4959 W4962 V4961)))))))))))))) false))) false))) false))) false)) false)) false)) false) (if (= W5106 false) (let W5119 (if (shen.unlocked? V4959) (let W5120 (shen.lazyderef V4955 V4958) (if (cons? W5120) (let W5121 (shen.lazyderef (hd W5120) V4958) (if (= W5121 open) (let W5122 (shen.lazyderef (tl W5120) V4958) (if (cons? W5122) (let W5123 (hd W5122) (let W5124 (shen.lazyderef (tl W5122) V4958) (if (cons? W5124) (let W5125 (hd W5124) (let W5126 (shen.lazyderef (tl W5124) V4958) (if (= W5126 ()) (let W5127 (shen.lazyderef V4956 V4958) (let W5128 (lambda Z5129 (do (shen.incinfs) (is! W5125 Z5129 V4958 V4959 W4962 (freeze (when (element? (shen.lazyderef Z5129 V4958) (cons in (cons out ()))) V4958 V4959 W4962 (freeze (shen.system-S-h W5123 string V4957 V4958 V4959 W4962 V4961))))))) (if (cons? W5127) (let W5130 (shen.lazyderef (hd W5127) V4958) (let W5131 (freeze (let W5132 (shen.lazyderef (tl W5127) V4958) (let W5133 (lambda Z5134 (W5128 Z5134)) (if (cons? W5132) (let W5135 (hd W5132) (let W5136 (shen.lazyderef (tl W5132) V4958) (let W5137 (freeze (W5133 W5135)) (if (= W5136 ()) (thaw W5137) (if (shen.pvar? W5136) (shen.bind! W5136 () V4958 W5137) false))))) (if (shen.pvar? W5132) (let W5138 (shen.newpv V4958) (shen.gc V4958 (shen.bind! W5132 (cons W5138 ()) V4958 (freeze (W5133 W5138))))) false))))) (if (= W5130 stream) (thaw W5131) (if (shen.pvar? W5130) (shen.bind! W5130 stream V4958 W5131) false)))) (if (shen.pvar? W5127) (let W5139 (shen.newpv V4958) (shen.gc V4958 (shen.bind! W5127 (cons stream (cons W5139 ())) V4958 (freeze (W5128 W5139))))) false)))) false))) false))) false)) false)) false)) false) (if (= W5119 false) (let W5140 (if (shen.unlocked? V4959) (let W5141 (shen.lazyderef V4955 V4958) (if (cons? W5141) (let W5142 (shen.lazyderef (hd W5141) V4958) (if (= W5142 type) (let W5143 (shen.lazyderef (tl W5141) V4958) (if (cons? W5143) (let W5144 (hd W5143) (let W5145 (shen.lazyderef (tl W5143) V4958) (if (cons? W5145) (let W5146 (hd W5145) (let W5147 (shen.lazyderef (tl W5145) V4958) (if (= W5147 ()) (do (shen.incinfs) (shen.cut V4958 V4959 W4962 (freeze (is! (shen.rectify-type (shen.deref W5146 V4958)) V4956 V4958 V4959 W4962 (freeze (shen.system-S-h W5144 V4956 V4957 V4958 V4959 W4962 V4961)))))) false))) false))) false)) false)) false)) false) (if (= W5140 false) (let W5148 (if (shen.unlocked? V4959) (let W5149 (shen.lazyderef V4955 V4958) (if (cons? W5149) (let W5150 (shen.lazyderef (hd W5149) V4958) (if (= W5150 input+) (let W5151 (shen.lazyderef (tl W5149) V4958) (if (cons? W5151) (let W5152 (hd W5151) (let W5153 (shen.lazyderef (tl W5151) V4958) (if (cons? W5153) (let W5154 (hd W5153) (let W5155 (shen.lazyderef (tl W5153) V4958) (if (= W5155 ()) (do (shen.incinfs) (is! V4956 (shen.rectify-type (shen.deref W5152 V4958)) V4958 V4959 W4962 (freeze (shen.system-S-h W5154 (cons stream (cons in ())) V4957 V4958 V4959 W4962 V4961)))) false))) false))) false)) false)) false)) false) (if (= W5148 false) (let W5156 (if (shen.unlocked? V4959) (let W5157 (shen.lazyderef V4955 V4958) (if (cons? W5157) (let W5158 (shen.lazyderef (hd W5157) V4958) (if (= W5158 set) (let W5159 (shen.lazyderef (tl W5157) V4958) (if (cons? W5159) (let W5160 (hd W5159) (let W5161 (shen.lazyderef (tl W5159) V4958) (if (cons? W5161) (let W5162 (hd W5161) (let W5163 (shen.lazyderef (tl W5161) V4958) (if (= W5163 ()) (do (shen.incinfs) (shen.system-S-h W5160 symbol V4957 V4958 V4959 W4962 (freeze (shen.system-S-h (cons value (cons W5160 ())) V4956 V4957 V4958 V4959 W4962 (freeze (shen.system-S-h W5162 V4956 V4957 V4958 V4959 W4962 V4961)))))) false))) false))) false)) false)) false)) false) (if (= W5156 false) (let W5164 (if (shen.unlocked? V4959) (let W5165 (shen.newpv V4958) (shen.gc V4958 (do (shen.incinfs) (shen.l-rules V4957 W5165 false V4958 V4959 W4962 (freeze (shen.cut V4958 V4959 W4962 (freeze (shen.system-S-h V4955 V4956 W5165 V4958 V4959 W4962 V4961)))))))) false) (if (= W5164 false) (let W5166 (if (shen.unlocked? V4959) (do (shen.incinfs) (shen.search-user-datatypes (cons V4955 (cons (intern ":") (cons V4956 ()))) V4957 (value shen.*datatypes*) V4958 V4959 W4962 V4961)) false) (if (= W5166 false) (shen.unlock V4959 W4962) W5166)) W5164)) W5156)) W5148)) W5140)) W5119)) W5106)) W5076)) W5066)) W5045)) W5017)) W4996)) W4989)) W4982)) W4976)) W4970)) W4966)) W4965)) W4964)) W4963)))) - -(defun shen.primitive (V5167 V5168 V5169 V5170 V5171 V5172) (let W5173 (if (shen.unlocked? V5170) (let W5174 (shen.lazyderef V5168 V5169) (let W5175 (freeze (do (shen.incinfs) (when (number? (shen.lazyderef V5167 V5169)) V5169 V5170 V5171 V5172))) (if (= W5174 number) (thaw W5175) (if (shen.pvar? W5174) (shen.bind! W5174 number V5169 W5175) false)))) false) (if (= W5173 false) (let W5176 (if (shen.unlocked? V5170) (let W5177 (shen.lazyderef V5168 V5169) (let W5178 (freeze (do (shen.incinfs) (when (boolean? (shen.lazyderef V5167 V5169)) V5169 V5170 V5171 V5172))) (if (= W5177 boolean) (thaw W5178) (if (shen.pvar? W5177) (shen.bind! W5177 boolean V5169 W5178) false)))) false) (if (= W5176 false) (let W5179 (if (shen.unlocked? V5170) (let W5180 (shen.lazyderef V5168 V5169) (let W5181 (freeze (do (shen.incinfs) (when (string? (shen.lazyderef V5167 V5169)) V5169 V5170 V5171 V5172))) (if (= W5180 string) (thaw W5181) (if (shen.pvar? W5180) (shen.bind! W5180 string V5169 W5181) false)))) false) (if (= W5179 false) (let W5182 (if (shen.unlocked? V5170) (let W5183 (shen.lazyderef V5168 V5169) (let W5184 (freeze (do (shen.incinfs) (when (symbol? (shen.lazyderef V5167 V5169)) V5169 V5170 V5171 V5172))) (if (= W5183 symbol) (thaw W5184) (if (shen.pvar? W5183) (shen.bind! W5183 symbol V5169 W5184) false)))) false) (if (= W5182 false) (if (shen.unlocked? V5170) (let W5185 (shen.lazyderef V5167 V5169) (if (= W5185 ()) (let W5186 (shen.lazyderef V5168 V5169) (let W5187 (lambda Z5188 (do (shen.incinfs) (thaw V5172))) (if (cons? W5186) (let W5189 (shen.lazyderef (hd W5186) V5169) (let W5190 (freeze (let W5191 (shen.lazyderef (tl W5186) V5169) (let W5192 (lambda Z5193 (W5187 Z5193)) (if (cons? W5191) (let W5194 (hd W5191) (let W5195 (shen.lazyderef (tl W5191) V5169) (let W5196 (freeze (W5192 W5194)) (if (= W5195 ()) (thaw W5196) (if (shen.pvar? W5195) (shen.bind! W5195 () V5169 W5196) false))))) (if (shen.pvar? W5191) (let W5197 (shen.newpv V5169) (shen.gc V5169 (shen.bind! W5191 (cons W5197 ()) V5169 (freeze (W5192 W5197))))) false))))) (if (= W5189 list) (thaw W5190) (if (shen.pvar? W5189) (shen.bind! W5189 list V5169 W5190) false)))) (if (shen.pvar? W5186) (let W5198 (shen.newpv V5169) (shen.gc V5169 (shen.bind! W5186 (cons list (cons W5198 ())) V5169 (freeze (W5187 W5198))))) false)))) false)) false) W5182)) W5179)) W5176)) W5173))) - -(defun shen.by-hypothesis (V5199 V5200 V5201 V5202 V5203 V5204 V5205) (let W5206 (if (shen.unlocked? V5203) (let W5207 (shen.lazyderef V5201 V5202) (if (cons? W5207) (let W5208 (shen.lazyderef (hd W5207) V5202) (if (cons? W5208) (let W5209 (hd W5208) (let W5210 (shen.lazyderef (tl W5208) V5202) (if (cons? W5210) (let W5211 (hd W5210) (let W5212 (shen.lazyderef (tl W5210) V5202) (if (cons? W5212) (let W5213 (hd W5212) (let W5214 (shen.lazyderef (tl W5212) V5202) (if (= W5214 ()) (do (shen.incinfs) (when (= (shen.deref W5211 V5202) (intern ":")) V5202 V5203 V5204 (freeze (when (= (shen.deref V5199 V5202) (shen.deref W5209 V5202)) V5202 V5203 V5204 (freeze (is! V5200 W5213 V5202 V5203 V5204 V5205)))))) false))) false))) false))) false)) false)) false) (if (= W5206 false) (if (shen.unlocked? V5203) (let W5215 (shen.lazyderef V5201 V5202) (if (cons? W5215) (let W5216 (tl W5215) (do (shen.incinfs) (shen.by-hypothesis V5199 V5200 W5216 V5202 V5203 V5204 V5205))) false)) false) W5206))) - -(defun shen.lookupsig (V5217 V5218 V5219 V5220 V5221 V5222) (if (shen.unlocked? V5220) (do (shen.incinfs) (shen.sigf (assoc V5217 (value shen.*sigf*)) V5218 V5219 V5220 V5221 V5222)) false)) - -(defun shen.sigf (V5237 V5238 V5239 V5240 V5241 V5242) (cond ((cons? V5237) ((((((tl V5237) V5238) V5239) V5240) V5241) V5242)) (true false))) - -(defun shen.freshterm (V5243) (let W5244 (absvector 3) (let W5245 (address-> W5244 0 shen.print-freshterm) (let W5246 (address-> W5245 1 V5243) (let W5247 (address-> W5246 2 (set shen.*gensym* (+ 1 (value shen.*gensym*)))) W5247))))) - -(defun shen.print-freshterm (V5248) (cn "&&" (str (<-address V5248 1)))) - -(defun shen.search-user-datatypes (V5249 V5250 V5251 V5252 V5253 V5254 V5255) (let W5256 (if (shen.unlocked? V5253) (let W5257 (shen.lazyderef V5251 V5252) (if (cons? W5257) (let W5258 (shen.lazyderef (hd W5257) V5252) (if (cons? W5258) (let W5259 (tl W5258) (do (shen.incinfs) (call (((shen.deref W5259 V5252) (shen.deref V5249 V5252)) (shen.deref V5250 V5252)) V5252 V5253 V5254 V5255))) false)) false)) false) (if (= W5256 false) (if (shen.unlocked? V5253) (let W5260 (shen.lazyderef V5251 V5252) (if (cons? W5260) (let W5261 (tl W5260) (do (shen.incinfs) (shen.search-user-datatypes V5249 V5250 W5261 V5252 V5253 V5254 V5255))) false)) false) W5256))) - -(defun shen.l-rules (V5262 V5263 V5264 V5265 V5266 V5267 V5268) (let W5269 (+ V5267 1) (let W5270 (if (shen.unlocked? V5266) (let W5271 (shen.lazyderef V5262 V5265) (if (= W5271 ()) (let W5272 (shen.lazyderef V5264 V5265) (if (= W5272 true) (do (shen.incinfs) (shen.cut V5265 V5266 W5269 (freeze (bind V5263 () V5265 V5266 W5269 V5268)))) false)) false)) false) (if (= W5270 false) (let W5273 (if (shen.unlocked? V5266) (let W5274 (shen.lazyderef V5262 V5265) (if (cons? W5274) (let W5275 (shen.lazyderef (hd W5274) V5265) (if (cons? W5275) (let W5276 (shen.lazyderef (hd W5275) V5265) (if (cons? W5276) (let W5277 (shen.lazyderef (hd W5276) V5265) (if (= W5277 cons) (let W5278 (shen.lazyderef (tl W5276) V5265) (if (cons? W5278) (let W5279 (hd W5278) (let W5280 (shen.lazyderef (tl W5278) V5265) (if (cons? W5280) (let W5281 (hd W5280) (let W5282 (shen.lazyderef (tl W5280) V5265) (if (= W5282 ()) (let W5283 (shen.lazyderef (tl W5275) V5265) (if (cons? W5283) (let W5284 (hd W5283) (let W5285 (shen.lazyderef (tl W5283) V5265) (if (cons? W5285) (let W5286 (shen.lazyderef (hd W5285) V5265) (if (cons? W5286) (let W5287 (shen.lazyderef (hd W5286) V5265) (if (= W5287 list) (let W5288 (shen.lazyderef (tl W5286) V5265) (if (cons? W5288) (let W5289 (hd W5288) (let W5290 (shen.lazyderef (tl W5288) V5265) (if (= W5290 ()) (let W5291 (shen.lazyderef (tl W5285) V5265) (if (= W5291 ()) (let W5292 (tl W5274) (do (shen.incinfs) (when (= (shen.deref W5284 V5265) (intern ":")) V5265 V5266 W5269 (freeze (shen.cut V5265 V5266 W5269 (freeze (shen.l-rules (cons (cons W5279 (cons W5284 (cons W5289 ()))) (cons (cons W5281 (cons W5284 (cons (cons list (cons W5289 ())) ()))) W5292)) V5263 true V5265 V5266 W5269 V5268))))))) false)) false))) false)) false)) false)) false))) false)) false))) false))) false)) false)) false)) false)) false)) false) (if (= W5273 false) (let W5293 (if (shen.unlocked? V5266) (let W5294 (shen.lazyderef V5262 V5265) (if (cons? W5294) (let W5295 (shen.lazyderef (hd W5294) V5265) (if (cons? W5295) (let W5296 (shen.lazyderef (hd W5295) V5265) (if (cons? W5296) (let W5297 (shen.lazyderef (hd W5296) V5265) (if (= W5297 @p) (let W5298 (shen.lazyderef (tl W5296) V5265) (if (cons? W5298) (let W5299 (hd W5298) (let W5300 (shen.lazyderef (tl W5298) V5265) (if (cons? W5300) (let W5301 (hd W5300) (let W5302 (shen.lazyderef (tl W5300) V5265) (if (= W5302 ()) (let W5303 (shen.lazyderef (tl W5295) V5265) (if (cons? W5303) (let W5304 (hd W5303) (let W5305 (shen.lazyderef (tl W5303) V5265) (if (cons? W5305) (let W5306 (shen.lazyderef (hd W5305) V5265) (if (cons? W5306) (let W5307 (hd W5306) (let W5308 (shen.lazyderef (tl W5306) V5265) (if (cons? W5308) (let W5309 (shen.lazyderef (hd W5308) V5265) (if (= W5309 *) (let W5310 (shen.lazyderef (tl W5308) V5265) (if (cons? W5310) (let W5311 (hd W5310) (let W5312 (shen.lazyderef (tl W5310) V5265) (if (= W5312 ()) (let W5313 (shen.lazyderef (tl W5305) V5265) (if (= W5313 ()) (let W5314 (tl W5294) (do (shen.incinfs) (when (= (shen.deref W5304 V5265) (intern ":")) V5265 V5266 W5269 (freeze (shen.cut V5265 V5266 W5269 (freeze (shen.l-rules (cons (cons W5299 (cons W5304 (cons W5307 ()))) (cons (cons W5301 (cons W5304 (cons W5311 ()))) W5314)) V5263 true V5265 V5266 W5269 V5268))))))) false)) false))) false)) false)) false))) false)) false))) false)) false))) false))) false)) false)) false)) false)) false)) false) (if (= W5293 false) (let W5315 (if (shen.unlocked? V5266) (let W5316 (shen.lazyderef V5262 V5265) (if (cons? W5316) (let W5317 (shen.lazyderef (hd W5316) V5265) (if (cons? W5317) (let W5318 (shen.lazyderef (hd W5317) V5265) (if (cons? W5318) (let W5319 (shen.lazyderef (hd W5318) V5265) (if (= W5319 @s) (let W5320 (shen.lazyderef (tl W5318) V5265) (if (cons? W5320) (let W5321 (hd W5320) (let W5322 (shen.lazyderef (tl W5320) V5265) (if (cons? W5322) (let W5323 (hd W5322) (let W5324 (shen.lazyderef (tl W5322) V5265) (if (= W5324 ()) (let W5325 (shen.lazyderef (tl W5317) V5265) (if (cons? W5325) (let W5326 (hd W5325) (let W5327 (shen.lazyderef (tl W5325) V5265) (if (cons? W5327) (let W5328 (shen.lazyderef (hd W5327) V5265) (if (= W5328 string) (let W5329 (shen.lazyderef (tl W5327) V5265) (if (= W5329 ()) (let W5330 (tl W5316) (do (shen.incinfs) (when (= (shen.deref W5326 V5265) (intern ":")) V5265 V5266 W5269 (freeze (shen.cut V5265 V5266 W5269 (freeze (shen.l-rules (cons (cons W5321 (cons W5326 (cons string ()))) (cons (cons W5323 (cons W5326 (cons string ()))) W5330)) V5263 true V5265 V5266 W5269 V5268))))))) false)) false)) false))) false)) false))) false))) false)) false)) false)) false)) false)) false) (if (= W5315 false) (let W5331 (if (shen.unlocked? V5266) (let W5332 (shen.lazyderef V5262 V5265) (if (cons? W5332) (let W5333 (shen.lazyderef (hd W5332) V5265) (if (cons? W5333) (let W5334 (shen.lazyderef (hd W5333) V5265) (if (cons? W5334) (let W5335 (shen.lazyderef (hd W5334) V5265) (if (= W5335 @v) (let W5336 (shen.lazyderef (tl W5334) V5265) (if (cons? W5336) (let W5337 (hd W5336) (let W5338 (shen.lazyderef (tl W5336) V5265) (if (cons? W5338) (let W5339 (hd W5338) (let W5340 (shen.lazyderef (tl W5338) V5265) (if (= W5340 ()) (let W5341 (shen.lazyderef (tl W5333) V5265) (if (cons? W5341) (let W5342 (hd W5341) (let W5343 (shen.lazyderef (tl W5341) V5265) (if (cons? W5343) (let W5344 (shen.lazyderef (hd W5343) V5265) (if (cons? W5344) (let W5345 (shen.lazyderef (hd W5344) V5265) (if (= W5345 vector) (let W5346 (shen.lazyderef (tl W5344) V5265) (if (cons? W5346) (let W5347 (hd W5346) (let W5348 (shen.lazyderef (tl W5346) V5265) (if (= W5348 ()) (let W5349 (shen.lazyderef (tl W5343) V5265) (if (= W5349 ()) (let W5350 (tl W5332) (do (shen.incinfs) (when (= (shen.deref W5342 V5265) (intern ":")) V5265 V5266 W5269 (freeze (shen.cut V5265 V5266 W5269 (freeze (shen.l-rules (cons (cons W5337 (cons W5342 (cons W5347 ()))) (cons (cons W5339 (cons W5342 (cons (cons vector (cons W5347 ())) ()))) W5350)) V5263 true V5265 V5266 W5269 V5268))))))) false)) false))) false)) false)) false)) false))) false)) false))) false))) false)) false)) false)) false)) false)) false) (if (= W5331 false) (let W5351 (if (shen.unlocked? V5266) (let W5352 (shen.lazyderef V5262 V5265) (if (cons? W5352) (let W5353 (hd W5352) (let W5354 (tl W5352) (let W5355 (shen.lazyderef V5263 V5265) (let W5356 (lambda Z5357 (lambda Z5358 (do (shen.incinfs) (bind Z5357 W5353 V5265 V5266 W5269 (freeze (shen.l-rules W5354 Z5358 V5264 V5265 V5266 W5269 V5268)))))) (if (cons? W5355) (let W5359 (hd W5355) (let W5360 (tl W5355) ((W5356 W5359) W5360))) (if (shen.pvar? W5355) (let W5361 (shen.newpv V5265) (shen.gc V5265 (let W5362 (shen.newpv V5265) (shen.gc V5265 (shen.bind! W5355 (cons W5361 W5362) V5265 (freeze ((W5356 W5361) W5362))))))) false)))))) false)) false) (if (= W5351 false) (shen.unlock V5266 W5269) W5351)) W5331)) W5315)) W5293)) W5273)) W5270)))) - -(defun shen.t* (V5363 V5364 V5365 V5366 V5367 V5368) (let W5369 (+ V5367 1) (let W5370 (if (shen.unlocked? V5366) (let W5371 (shen.lazyderef V5363 V5365) (if (cons? W5371) (let W5372 (shen.lazyderef (hd W5371) V5365) (if (= W5372 define) (let W5373 (shen.lazyderef (tl W5371) V5365) (if (cons? W5373) (let W5374 (hd W5373) (let W5375 (tl W5373) (let W5376 (shen.newpv V5365) (shen.gc V5365 (let W5377 (shen.newpv V5365) (shen.gc V5365 (let W5378 (shen.newpv V5365) (shen.gc V5365 (let W5379 (shen.newpv V5365) (shen.gc V5365 (do (shen.incinfs) (shen.cut V5365 V5366 W5369 (freeze (bind W5376 (shen.sigxrules (cons W5374 W5375)) V5365 V5366 W5369 (freeze (bind W5379 (fst (shen.lazyderef W5376 V5365)) V5365 V5366 W5369 (freeze (bind W5377 (snd (shen.lazyderef W5376 V5365)) V5365 V5366 W5369 (freeze (bind W5378 (shen.freshen-sig (shen.deref W5379 V5365)) V5365 V5366 W5369 (freeze (shen.t*-rules W5374 W5377 W5378 1 V5365 V5366 W5369 (freeze (is W5379 V5364 V5365 V5366 W5369 V5368)))))))))))))))))))))))) false)) false)) false)) false) (if (= W5370 false) (shen.unlock V5366 W5369) W5370)))) - -(defun shen.sigxrules (V5380) (compile (lambda Z5381 (shen. Z5381)) V5380)) - -(defun shen. (V5382) (let W5383 (if (cons? V5382) (let W5384 (tail V5382) (if (shen.hds=? W5384 {) (let W5385 (tail W5384) (let W5386 (shen. W5385) (if (shen.parse-failure? W5386) (shen.parse-failure) (let W5387 (shen.<-out W5386) (let W5388 (shen.in-> W5386) (if (shen.hds=? W5388 }) (let W5389 (tail W5388) (let W5390 (shen. W5389) (if (shen.parse-failure? W5390) (shen.parse-failure) (let W5391 (shen.<-out W5390) (let W5392 (shen.in-> W5390) (shen.comb W5392 (let W5393 (shen.rectify-type W5387) (@p W5393 W5391)))))))) (shen.parse-failure))))))) (shen.parse-failure))) (shen.parse-failure)) (if (shen.parse-failure? W5383) (shen.parse-failure) W5383))) - -(defun shen.freshen-sig (V5394) (let W5395 (shen.extract-vars V5394) (let W5396 (map (lambda Z5397 (cons Z5397 (shen.freshterm (concat & Z5397)))) W5395) (shen.freshen-type W5396 V5394)))) - -(defun shen.freshen-type (V5398 V5399) (cond ((= () V5398) V5399) ((and (cons? V5398) (cons? (hd V5398))) (shen.freshen-type (tl V5398) (subst (tl (hd V5398)) (hd (hd V5398)) V5399))) (true (shen.f-error shen.freshen-type)))) - -(defun shen. (V5400) (let W5401 (let W5402 (shen. V5400) (if (shen.parse-failure? W5402) (shen.parse-failure) (let W5403 (shen.<-out W5402) (let W5404 (shen.in-> W5402) (let W5405 (shen. W5404) (if (shen.parse-failure? W5405) (shen.parse-failure) (let W5406 (shen.<-out W5405) (let W5407 (shen.in-> W5405) (shen.comb W5407 (cons W5403 W5406)))))))))) (if (shen.parse-failure? W5401) (let W5408 (let W5409 (shen. V5400) (if (shen.parse-failure? W5409) (shen.parse-failure) (let W5410 (shen.<-out W5409) (let W5411 (shen.in-> W5409) (shen.comb W5411 (cons W5410 ())))))) (if (shen.parse-failure? W5408) (shen.parse-failure) W5408)) W5401))) - -(defun shen. (V5412) (let W5413 (let W5414 (shen. V5412) (if (shen.parse-failure? W5414) (shen.parse-failure) (let W5415 (shen.<-out W5414) (let W5416 (shen.in-> W5414) (if (shen.hds=? W5416 ->) (let W5417 (tail W5416) (if (cons? W5417) (let W5418 (head W5417) (let W5419 (tail W5417) (if (shen.hds=? W5419 where) (let W5420 (tail W5419) (if (cons? W5420) (let W5421 (head W5420) (let W5422 (tail W5420) (shen.comb W5422 (@p W5415 (cons where (cons W5421 (cons W5418 ()))))))) (shen.parse-failure))) (shen.parse-failure)))) (shen.parse-failure))) (shen.parse-failure)))))) (if (shen.parse-failure? W5413) (let W5423 (let W5424 (shen. V5412) (if (shen.parse-failure? W5424) (shen.parse-failure) (let W5425 (shen.<-out W5424) (let W5426 (shen.in-> W5424) (if (shen.hds=? W5426 <-) (let W5427 (tail W5426) (if (cons? W5427) (let W5428 (head W5427) (let W5429 (tail W5427) (if (shen.hds=? W5429 where) (let W5430 (tail W5429) (if (cons? W5430) (let W5431 (head W5430) (let W5432 (tail W5430) (shen.comb W5432 (@p W5425 (shen.correct (cons where (cons W5431 (cons W5428 ())))))))) (shen.parse-failure))) (shen.parse-failure)))) (shen.parse-failure))) (shen.parse-failure)))))) (if (shen.parse-failure? W5423) (let W5433 (let W5434 (shen. V5412) (if (shen.parse-failure? W5434) (shen.parse-failure) (let W5435 (shen.<-out W5434) (let W5436 (shen.in-> W5434) (if (shen.hds=? W5436 <-) (let W5437 (tail W5436) (if (cons? W5437) (let W5438 (head W5437) (let W5439 (tail W5437) (shen.comb W5439 (@p W5435 (shen.correct W5438))))) (shen.parse-failure))) (shen.parse-failure)))))) (if (shen.parse-failure? W5433) (let W5440 (let W5441 (shen. V5412) (if (shen.parse-failure? W5441) (shen.parse-failure) (let W5442 (shen.<-out W5441) (let W5443 (shen.in-> W5441) (if (shen.hds=? W5443 ->) (let W5444 (tail W5443) (if (cons? W5444) (let W5445 (head W5444) (let W5446 (tail W5444) (shen.comb W5446 (@p W5442 W5445)))) (shen.parse-failure))) (shen.parse-failure)))))) (if (shen.parse-failure? W5440) (shen.parse-failure) W5440)) W5433)) W5423)) W5413))) - -(defun shen.correct (V5447) (cond ((and (cons? V5447) (and (= where (hd V5447)) (and (cons? (tl V5447)) (and (cons? (tl (tl V5447))) (and (cons? (hd (tl (tl V5447)))) (and (= fail-if (hd (hd (tl (tl V5447))))) (and (cons? (tl (hd (tl (tl V5447))))) (and (cons? (tl (tl (hd (tl (tl V5447)))))) (and (= () (tl (tl (tl (hd (tl (tl V5447))))))) (= () (tl (tl (tl V5447))))))))))))) (cons where (cons (cons and (cons (hd (tl V5447)) (cons (cons not (cons (tl (hd (tl (tl V5447)))) ())) ()))) (tl (tl (hd (tl (tl V5447)))))))) ((and (cons? V5447) (and (= where (hd V5447)) (and (cons? (tl V5447)) (and (cons? (tl (tl V5447))) (= () (tl (tl (tl V5447)))))))) (cons where (cons (cons and (cons (hd (tl V5447)) (cons (cons not (cons (cons = (cons (hd (tl (tl V5447))) (cons (cons fail ()) ()))) ())) ()))) (tl (tl V5447))))) ((and (cons? V5447) (and (= fail-if (hd V5447)) (and (cons? (tl V5447)) (and (cons? (tl (tl V5447))) (= () (tl (tl (tl V5447)))))))) (cons where (cons (cons not (cons (tl V5447) ())) (tl (tl V5447))))) (true (cons where (cons (cons not (cons (cons = (cons V5447 (cons (cons fail ()) ()))) ())) (cons V5447 ())))))) - -(defun shen.t*-rules (V5448 V5449 V5450 V5451 V5452 V5453 V5454 V5455) (let W5456 (+ V5454 1) (let W5457 (if (shen.unlocked? V5453) (let W5458 (shen.lazyderef V5449 V5452) (if (= W5458 ()) (do (shen.incinfs) (thaw V5455)) false)) false) (if (= W5457 false) (let W5459 (if (shen.unlocked? V5453) (let W5460 (shen.lazyderef V5449 V5452) (if (cons? W5460) (let W5461 (hd W5460) (let W5462 (tl W5460) (let W5463 (shen.newpv V5452) (shen.gc V5452 (do (shen.incinfs) (bind W5463 (shen.freshen-rule (shen.deref W5461 V5452)) V5452 V5453 W5456 (freeze (shen.t*-rule V5448 V5451 (fst (shen.lazyderef W5463 V5452)) (snd (shen.lazyderef W5463 V5452)) V5450 V5452 V5453 W5456 (freeze (shen.cut V5452 V5453 W5456 (freeze (shen.t*-rules V5448 W5462 V5450 (+ V5451 1) V5452 V5453 W5456 V5455)))))))))))) false)) false) (if (= W5459 false) (shen.unlock V5453 W5456) W5459)) W5457)))) - -(defun shen.freshen-rule (V5464) (cond ((tuple? V5464) (let W5465 (shen.extract-vars (fst V5464)) (let W5466 (map (lambda Z5467 (cons Z5467 (shen.freshterm Z5467))) W5465) (@p (shen.freshen W5466 (fst V5464)) (shen.freshen W5466 (snd V5464)))))) (true (shen.f-error shen.freshen-rule)))) - -(defun shen.freshen (V5468 V5469) (cond ((= () V5468) V5469) ((and (cons? V5468) (cons? (hd V5468))) (shen.freshen (tl V5468) (shen.beta (hd (hd V5468)) (tl (hd V5468)) V5469))) (true (shen.f-error shen.freshen)))) - -(defun shen.t*-rule (V5470 V5471 V5472 V5473 V5474 V5475 V5476 V5477 V5478) (let W5479 (if (shen.unlocked? V5476) (do (shen.incinfs) (shen.t*-rule-h V5472 V5473 V5474 V5475 V5476 V5477 V5478)) false) (if (= W5479 false) (if (shen.unlocked? V5476) (let W5480 (shen.newpv V5475) (shen.gc V5475 (do (shen.incinfs) (bind W5480 (simple-error (cn "type error in rule " (shen.app V5471 (cn " of " (shen.app V5470 " -" shen.a)) shen.a))) V5475 V5476 V5477 V5478)))) false) W5479))) - -(defun shen.t*-rule-h (V5481 V5482 V5483 V5484 V5485 V5486 V5487) (let W5488 (+ V5486 1) (let W5489 (if (shen.unlocked? V5485) (let W5490 (shen.lazyderef V5481 V5484) (if (= W5490 ()) (let W5491 (shen.lazyderef V5483 V5484) (if (cons? W5491) (let W5492 (shen.lazyderef (hd W5491) V5484) (if (= W5492 -->) (let W5493 (shen.lazyderef (tl W5491) V5484) (if (cons? W5493) (let W5494 (hd W5493) (let W5495 (shen.lazyderef (tl W5493) V5484) (if (= W5495 ()) (do (shen.incinfs) (shen.cut V5484 V5485 W5488 (freeze (shen.t*-correct V5482 W5494 () V5484 V5485 W5488 V5487)))) false))) false)) false)) false)) false)) false) (if (= W5489 false) (let W5496 (if (shen.unlocked? V5485) (let W5497 (shen.newpv V5484) (shen.gc V5484 (let W5498 (shen.newpv V5484) (shen.gc V5484 (let W5499 (shen.newpv V5484) (shen.gc V5484 (do (shen.incinfs) (shen.p-hyps (shen.freshterms V5481) W5497 V5484 V5485 W5488 (freeze (shen.t*-integrity V5481 V5483 W5497 W5498 V5484 V5485 W5488 (freeze (shen.cut V5484 V5485 W5488 (freeze (shen.myassume V5481 V5483 W5499 V5484 V5485 W5488 (freeze (shen.t*-correct V5482 W5498 W5499 V5484 V5485 W5488 V5487)))))))))))))))) false) (if (= W5496 false) (shen.unlock V5485 W5488) W5496)) W5489)))) - -(defun shen.myassume (V5500 V5501 V5502 V5503 V5504 V5505 V5506) (let W5507 (if (shen.unlocked? V5504) (let W5508 (shen.lazyderef V5500 V5503) (if (= W5508 ()) (let W5509 (shen.lazyderef V5502 V5503) (let W5510 (freeze (do (shen.incinfs) (thaw V5506))) (if (= W5509 ()) (thaw W5510) (if (shen.pvar? W5509) (shen.bind! W5509 () V5503 W5510) false)))) false)) false) (if (= W5507 false) (if (shen.unlocked? V5504) (let W5511 (shen.lazyderef V5500 V5503) (if (cons? W5511) (let W5512 (hd W5511) (let W5513 (tl W5511) (let W5514 (shen.lazyderef V5501 V5503) (if (cons? W5514) (let W5515 (hd W5514) (let W5516 (shen.lazyderef (tl W5514) V5503) (if (cons? W5516) (let W5517 (shen.lazyderef (hd W5516) V5503) (if (= W5517 -->) (let W5518 (shen.lazyderef (tl W5516) V5503) (if (cons? W5518) (let W5519 (hd W5518) (let W5520 (shen.lazyderef (tl W5518) V5503) (if (= W5520 ()) (let W5521 (shen.lazyderef V5502 V5503) (let W5522 (lambda Z5523 (lambda Z5524 (lambda Z5525 (lambda Z5526 (do (shen.incinfs) (is! W5515 Z5525 V5503 V5504 V5505 (freeze (is! W5512 Z5523 V5503 V5504 V5505 (freeze (bind Z5524 (intern ":") V5503 V5504 V5505 (freeze (shen.myassume W5513 W5519 Z5526 V5503 V5504 V5505 V5506)))))))))))) (if (cons? W5521) (let W5527 (shen.lazyderef (hd W5521) V5503) (let W5528 (lambda Z5529 (lambda Z5530 (lambda Z5531 (let W5532 (tl W5521) ((((W5522 Z5529) Z5530) Z5531) W5532))))) (if (cons? W5527) (let W5533 (hd W5527) (let W5534 (shen.lazyderef (tl W5527) V5503) (let W5535 (lambda Z5536 (lambda Z5537 (((W5528 W5533) Z5536) Z5537))) (if (cons? W5534) (let W5538 (hd W5534) (let W5539 (shen.lazyderef (tl W5534) V5503) (let W5540 (lambda Z5541 ((W5535 W5538) Z5541)) (if (cons? W5539) (let W5542 (hd W5539) (let W5543 (shen.lazyderef (tl W5539) V5503) (let W5544 (freeze (W5540 W5542)) (if (= W5543 ()) (thaw W5544) (if (shen.pvar? W5543) (shen.bind! W5543 () V5503 W5544) false))))) (if (shen.pvar? W5539) (let W5545 (shen.newpv V5503) (shen.gc V5503 (shen.bind! W5539 (cons W5545 ()) V5503 (freeze (W5540 W5545))))) false))))) (if (shen.pvar? W5534) (let W5546 (shen.newpv V5503) (shen.gc V5503 (let W5547 (shen.newpv V5503) (shen.gc V5503 (shen.bind! W5534 (cons W5546 (cons W5547 ())) V5503 (freeze ((W5535 W5546) W5547))))))) false))))) (if (shen.pvar? W5527) (let W5548 (shen.newpv V5503) (shen.gc V5503 (let W5549 (shen.newpv V5503) (shen.gc V5503 (let W5550 (shen.newpv V5503) (shen.gc V5503 (shen.bind! W5527 (cons W5548 (cons W5549 (cons W5550 ()))) V5503 (freeze (((W5528 W5548) W5549) W5550))))))))) false)))) (if (shen.pvar? W5521) (let W5551 (shen.newpv V5503) (shen.gc V5503 (let W5552 (shen.newpv V5503) (shen.gc V5503 (let W5553 (shen.newpv V5503) (shen.gc V5503 (let W5554 (shen.newpv V5503) (shen.gc V5503 (shen.bind! W5521 (cons (cons W5551 (cons W5552 (cons W5553 ()))) W5554) V5503 (freeze ((((W5522 W5551) W5552) W5553) W5554))))))))))) false)))) false))) false)) false)) false))) false)))) false)) false) W5507))) - -(defun shen.freshterms (V5557) (cond ((= () V5557) ()) ((and (cons? V5557) (cons? (hd V5557))) (shen.freshterms (append (hd V5557) (tl V5557)))) ((and (cons? V5557) (shen.freshterm? (hd V5557))) (adjoin (hd V5557) (shen.freshterms (tl V5557)))) ((cons? V5557) (shen.freshterms (tl V5557))) (true (shen.f-error shen.freshterms)))) - -(defun shen.p-hyps (V5558 V5559 V5560 V5561 V5562 V5563) (let W5564 (if (shen.unlocked? V5561) (let W5565 (shen.lazyderef V5558 V5560) (if (= W5565 ()) (let W5566 (shen.lazyderef V5559 V5560) (let W5567 (freeze (do (shen.incinfs) (thaw V5563))) (if (= W5566 ()) (thaw W5567) (if (shen.pvar? W5566) (shen.bind! W5566 () V5560 W5567) false)))) false)) false) (if (= W5564 false) (if (shen.unlocked? V5561) (let W5568 (shen.lazyderef V5558 V5560) (if (cons? W5568) (let W5569 (hd W5568) (let W5570 (tl W5568) (let W5571 (shen.lazyderef V5559 V5560) (let W5572 (lambda Z5573 (lambda Z5574 (lambda Z5575 (lambda Z5576 (do (shen.incinfs) (bind Z5573 W5569 V5560 V5561 V5562 (freeze (bind Z5574 (intern ":") V5560 V5561 V5562 (freeze (shen.p-hyps W5570 Z5576 V5560 V5561 V5562 V5563)))))))))) (if (cons? W5571) (let W5577 (shen.lazyderef (hd W5571) V5560) (let W5578 (lambda Z5579 (lambda Z5580 (lambda Z5581 (let W5582 (tl W5571) ((((W5572 Z5579) Z5580) Z5581) W5582))))) (if (cons? W5577) (let W5583 (hd W5577) (let W5584 (shen.lazyderef (tl W5577) V5560) (let W5585 (lambda Z5586 (lambda Z5587 (((W5578 W5583) Z5586) Z5587))) (if (cons? W5584) (let W5588 (hd W5584) (let W5589 (shen.lazyderef (tl W5584) V5560) (let W5590 (lambda Z5591 ((W5585 W5588) Z5591)) (if (cons? W5589) (let W5592 (hd W5589) (let W5593 (shen.lazyderef (tl W5589) V5560) (let W5594 (freeze (W5590 W5592)) (if (= W5593 ()) (thaw W5594) (if (shen.pvar? W5593) (shen.bind! W5593 () V5560 W5594) false))))) (if (shen.pvar? W5589) (let W5595 (shen.newpv V5560) (shen.gc V5560 (shen.bind! W5589 (cons W5595 ()) V5560 (freeze (W5590 W5595))))) false))))) (if (shen.pvar? W5584) (let W5596 (shen.newpv V5560) (shen.gc V5560 (let W5597 (shen.newpv V5560) (shen.gc V5560 (shen.bind! W5584 (cons W5596 (cons W5597 ())) V5560 (freeze ((W5585 W5596) W5597))))))) false))))) (if (shen.pvar? W5577) (let W5598 (shen.newpv V5560) (shen.gc V5560 (let W5599 (shen.newpv V5560) (shen.gc V5560 (let W5600 (shen.newpv V5560) (shen.gc V5560 (shen.bind! W5577 (cons W5598 (cons W5599 (cons W5600 ()))) V5560 (freeze (((W5578 W5598) W5599) W5600))))))))) false)))) (if (shen.pvar? W5571) (let W5601 (shen.newpv V5560) (shen.gc V5560 (let W5602 (shen.newpv V5560) (shen.gc V5560 (let W5603 (shen.newpv V5560) (shen.gc V5560 (let W5604 (shen.newpv V5560) (shen.gc V5560 (shen.bind! W5571 (cons (cons W5601 (cons W5602 (cons W5603 ()))) W5604) V5560 (freeze ((((W5572 W5601) W5602) W5603) W5604))))))))))) false)))))) false)) false) W5564))) - -(defun shen.t*-correct (V5605 V5606 V5607 V5608 V5609 V5610 V5611) (let W5612 (+ V5610 1) (let W5613 (if (shen.unlocked? V5609) (let W5614 (shen.lazyderef V5605 V5608) (if (cons? W5614) (let W5615 (shen.lazyderef (hd W5614) V5608) (if (= W5615 where) (let W5616 (shen.lazyderef (tl W5614) V5608) (if (cons? W5616) (let W5617 (hd W5616) (let W5618 (shen.lazyderef (tl W5616) V5608) (if (cons? W5618) (let W5619 (hd W5618) (let W5620 (shen.lazyderef (tl W5618) V5608) (if (= W5620 ()) (let W5621 (shen.newpv V5608) (shen.gc V5608 (do (shen.incinfs) (shen.cut V5608 V5609 W5612 (freeze (bind W5621 (shen.curry W5617) V5608 V5609 W5612 (freeze (shen.system-S-h W5621 boolean V5607 V5608 V5609 W5612 (freeze (shen.cut V5608 V5609 W5612 (freeze (shen.t*-correct W5619 V5606 (cons (cons W5621 (cons (intern ":") (cons verified ()))) V5607) V5608 V5609 W5612 V5611)))))))))))) false))) false))) false)) false)) false)) false) (if (= W5613 false) (let W5622 (if (shen.unlocked? V5609) (do (shen.incinfs) (shen.system-S-h (shen.curry V5605) V5606 V5607 V5608 V5609 W5612 V5611)) false) (if (= W5622 false) (shen.unlock V5609 W5612) W5622)) W5613)))) - -(defun shen.t*-integrity (V5623 V5624 V5625 V5626 V5627 V5628 V5629 V5630) (let W5631 (if (shen.unlocked? V5628) (let W5632 (shen.lazyderef V5623 V5627) (if (= W5632 ()) (do (shen.incinfs) (is! V5624 V5626 V5627 V5628 V5629 V5630)) false)) false) (if (= W5631 false) (if (shen.unlocked? V5628) (let W5633 (shen.lazyderef V5623 V5627) (if (cons? W5633) (let W5634 (hd W5633) (let W5635 (tl W5633) (let W5636 (shen.lazyderef V5624 V5627) (if (cons? W5636) (let W5637 (hd W5636) (let W5638 (shen.lazyderef (tl W5636) V5627) (if (cons? W5638) (let W5639 (shen.lazyderef (hd W5638) V5627) (if (= W5639 -->) (let W5640 (shen.lazyderef (tl W5638) V5627) (if (cons? W5640) (let W5641 (hd W5640) (let W5642 (shen.lazyderef (tl W5640) V5627) (if (= W5642 ()) (do (shen.incinfs) (shen.system-S-h W5634 W5637 V5625 V5627 V5628 V5629 (freeze (shen.t*-integrity W5635 W5641 V5625 V5626 V5627 V5628 V5629 V5630)))) false))) false)) false)) false))) false)))) false)) false) W5631))) - -(defun shen.freshterm? (V5643) (and (absvector? V5643) (and (not (string? V5643)) (= (<-address V5643 0) shen.print-freshterm)))) - -(defun shen.initialise-environment () (do (set shen.*history* ()) (do (set shen.*tc* false) (do (set *property-vector* (shen.dict 20000)) (do (set *macros* (cons (cons shen.macros (lambda X (shen.macros X))) ())) (do (set shen.*gensym* 0) (do (set shen.*tracking* ()) (do (set shen.*profiled* ()) (do (set shen.*special* (cons @p (cons @s (cons @v (cons cons (cons lambda (cons let (cons where (cons set (cons open (cons input+ (cons type ())))))))))))) (do (set shen.*extraspecial* ()) (do (set shen.*spy* false) (do (set shen.*datatypes* ()) (do (set shen.*alldatatypes* ()) (do (set shen.*shen-type-theory-enabled?* true) (do (set shen.*package* null) (do (set shen.*synonyms* ()) (do (set shen.*system* ()) (do (set shen.*occurs* true) (do (set shen.*factorise?* false) (do (set shen.*maxinferences* 1000000) (do (set *maximum-print-sequence-size* 20) (do (set shen.*call* 0) (do (set shen.*infs* 0) (do (set *hush* false) (do (set shen.*optimise* false) (do (set *version* "41.2") (do (set shen.*names* ()) (do (set shen.*step* false) (do (set shen.*it* "") (do (set shen.*residue* ()) (do (set *absolute* ()) (do (set shen.*prolog-memory* 1000) (do (set shen.*loading?* false) (do (set shen.*userdefs* ()) (do (set shen.*demodulation-function* (lambda X X)) (do (set shen.*custom-pattern-compiler* false) (do (set shen.*custom-pattern-reducer* false) (do (if (not (bound? *home-directory*)) (set *home-directory* "") shen.skip) (do (if (not (bound? *sterror*)) (set *sterror* (value *stoutput*)) shen.skip) (do (prolog-memory 10000) (do (set shen.*loading?* false) (do (shen.initialise-arity-table (cons abort (cons 0 (cons absolute (cons 1 (cons absvector? (cons 1 (cons absvector (cons 1 (cons address-> (cons 3 (cons adjoin (cons 2 (cons and (cons 2 (cons append (cons 2 (cons arity (cons 1 (cons assoc (cons 2 (cons atom? (cons 1 (cons boolean? (cons 1 (cons bootstrap (cons 1 (cons bound? (cons 1 (cons bind (cons 6 (cons call (cons 5 (cons cd (cons 1 (cons compile (cons 2 (cons concat (cons 2 (cons cons (cons 2 (cons cons? (cons 1 (cons cn (cons 2 (cons close (cons 1 (cons datatypes (cons 0 (cons declare (cons 2 (cons destroy (cons 1 (cons difference (cons 2 (cons do (cons 2 (cons element? (cons 2 (cons empty? (cons 1 (cons enable-type-theory (cons 1 (cons external (cons 1 (cons error-to-string (cons 1 (cons eval (cons 1 (cons eval-kl (cons 1 (cons explode (cons 1 (cons external (cons 1 (cons factorise (cons 1 (cons factorise? (cons 0 (cons fail-if (cons 2 (cons fail (cons 0 (cons fix (cons 2 (cons findall (cons 7 (cons foreign (cons 1 (cons fork (cons 5 (cons freeze (cons 1 (cons fresh (cons 0 (cons fst (cons 1 (cons fn (cons 1 (cons function (cons 1 (cons gensym (cons 1 (cons get (cons 3 (cons get-time (cons 1 (cons address-> (cons 3 (cons <-address (cons 2 (cons <-vector (cons 2 (cons > (cons 2 (cons >= (cons 2 (cons = (cons 2 (cons hash (cons 2 (cons hd (cons 1 (cons hdv (cons 1 (cons hdstr (cons 1 (cons head (cons 1 (cons hush? (cons 0 (cons hush (cons 1 (cons if (cons 3 (cons include (cons 1 (cons shen.included (cons 0 (cons in-package (cons 1 (cons integer? (cons 1 (cons internal (cons 1 (cons intern (cons 1 (cons inferences (cons 0 (cons input (cons 1 (cons input+ (cons 2 (cons implementation (cons 0 (cons include-all-but (cons 1 (cons intersection (cons 2 (cons internal (cons 1 (cons it (cons 0 (cons is (cons 6 (cons is! (cons 6 (cons language (cons 0 (cons length (cons 1 (cons limit (cons 1 (cons lineread (cons 1 (cons list (cons 1 (cons load (cons 1 (cons < (cons 2 (cons <= (cons 2 (cons vector (cons 1 (cons macroexpand (cons 1 (cons map (cons 2 (cons mapcan (cons 2 (cons maxinferences (cons 1 (cons nl (cons 1 (cons not (cons 1 (cons nth (cons 2 (cons n->string (cons 1 (cons number? (cons 1 (cons occurs-check (cons 1 (cons occurrences (cons 2 (cons occurs? (cons 0 (cons occurs-check (cons 1 (cons open (cons 2 (cons optimise (cons 1 (cons optimise? (cons 0 (cons or (cons 2 (cons os (cons 0 (cons package (cons 3 (cons package? (cons 1 (cons port (cons 0 (cons porters (cons 0 (cons pos (cons 2 (cons preclude-all-but (cons 1 (cons print (cons 1 (cons profile (cons 1 (cons shen.print-prolog-vector (cons 1 (cons shen.print-freshterm (cons 1 (cons shen.printF (cons 1 (cons prolog-memory (cons 1 (cons profile-results (cons 1 (cons pr (cons 2 (cons ps (cons 1 (cons preclude (cons 1 (cons preclude-all-but (cons 1 (cons protect (cons 1 (cons put (cons 4 (cons read-file-as-string (cons 1 (cons read-file-as-bytelist (cons 1 (cons read-file (cons 1 (cons read (cons 1 (cons read-byte (cons 1 (cons read-from-string (cons 1 (cons read-from-string-unprocessed (cons 1 (cons shen.read-unit-string (cons 1 (cons receive (cons 1 (cons release (cons 0 (cons remove (cons 2 (cons reverse (cons 1 (cons set (cons 2 (cons simple-error (cons 1 (cons snd (cons 1 (cons specialise (cons 2 (cons spy (cons 1 (cons shen.spy? (cons 0 (cons step (cons 1 (cons shen.step? (cons 0 (cons stinput (cons 0 (cons stoutput (cons 0 (cons str (cons 1 (cons string->n (cons 1 (cons string->symbol (cons 1 (cons string? (cons 1 (cons subst (cons 3 (cons sum (cons 1 (cons symbol? (cons 1 (cons systemf (cons 1 (cons tail (cons 1 (cons tl (cons 1 (cons tc (cons 1 (cons tc? (cons 0 (cons thaw (cons 1 (cons tlstr (cons 1 (cons track (cons 1 (cons tracked (cons 0 (cons trap-error (cons 2 (cons tuple? (cons 1 (cons type (cons 2 (cons return (cons 5 (cons unabsolute (cons 1 (cons undefmacro (cons 1 (cons unput (cons 3 (cons unprofile (cons 1 (cons union (cons 2 (cons untrack (cons 1 (cons undefmacro (cons 1 (cons update-lambda-table (cons 2 (cons userdefs (cons 0 (cons vector (cons 1 (cons vector? (cons 1 (cons vector-> (cons 3 (cons value (cons 1 (cons variable? (cons 1 (cons var? (cons 5 (cons version (cons 0 (cons when (cons 5 (cons write-byte (cons 2 (cons write-to-file (cons 2 (cons y-or-n? (cons 1 (cons + (cons 2 (cons * (cons 2 (cons / (cons 2 (cons - (cons 2 (cons == (cons 2 (cons (cons 1 (cons (cons 1 (cons (cons 1 (cons @p (cons 2 (cons @v (cons 2 (cons @s (cons 2 ()))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) (do (put shen shen.external-symbols (cons ! (cons } (cons { (cons --> (cons <-- (cons && (cons (intern ":") (cons (intern ";") (cons (intern ":=") (cons (intern ",") (cons _ (cons *language* (cons *implementation* (cons *stinput* (cons *sterror* (cons *stoutput* (cons *home-directory* (cons *version* (cons *maximum-print-sequence-size* (cons *macros* (cons *os* (cons *release* (cons *property-vector* (cons @v (cons @p (cons @s (cons *port* (cons *porters* (cons *hush* (cons <- (cons -> (cons (cons == (cons = (cons >= (cons > (cons ==> (cons /. (cons (cons (cons $ (cons - (cons / (cons * (cons + (cons <= (cons < (cons >> (cons (vector 0) (cons y-or-n? (cons write-to-file (cons write-byte (cons where (cons when (cons warn (cons version (cons verified (cons variable? (cons var? (cons value (cons vector-> (cons <-vector (cons vector (cons vector? (cons u! (cons update-lambda-table (cons unspecialise (cons untrack (cons unit (cons shen.unix (cons union (cons unput (cons unprofile (cons undefmacro (cons unabsolute (cons return (cons type (cons tuple? (cons true (cons trap-error (cons track (cons time (cons thaw (cons tc? (cons tc (cons tl (cons tlstr (cons tlv (cons tail (cons systemf (cons synonyms (cons symbol (cons symbol? (cons string->symbol (cons sum (cons subst (cons string? (cons string->n (cons stream (cons string (cons stinput (cons sterror (cons stoutput (cons step (cons spy (cons specialise (cons snd (cons simple-error (cons set (cons save (cons str (cons run (cons reverse (cons retract (cons remove (cons release (cons read (cons receive (cons read-file (cons read-file-as-bytelist (cons read-file-as-string (cons read-byte (cons read-from-string (cons read-from-string-unprocessed (cons package? (cons put (cons preclude (cons preclude-all-but (cons ps (cons prolog? (cons protect (cons profile-results (cons profile (cons prolog-memory (cons print (cons pr (cons pos (cons porters (cons port (cons package (cons output (cons out (cons os (cons or (cons optimise (cons open (cons occurrences (cons occurs-check (cons n->string (cons number? (cons number (cons null (cons nth (cons not (cons nl (cons mode (cons macroexpand (cons maxinferences (cons mapcan (cons map (cons make-string (cons load (cons loaded (cons list (cons lineread (cons limit (cons length (cons let (cons lazy (cons lambda (cons language (cons is (cons intersection (cons inferences (cons intern (cons integer? (cons input (cons input+ (cons inline (cons include (cons include-all-but (cons it (cons is (cons is! (cons in (cons in-package (cons internal (cons implementation (cons if (cons head (cons hd (cons hdv (cons hdstr (cons hash (cons get (cons get-time (cons gensym (cons fn (cons function (cons fst (cons freeze (cons fresh (cons fork (cons foreign (cons fix (cons file (cons fail (cons fail-if (cons factorise (cons findall (cons false (cons enable-type-theory (cons explode (cons external (cons exception (cons eval-kl (cons eval (cons error-to-string (cons error (cons empty? (cons element? (cons do (cons difference (cons destroy (cons defun (cons define (cons defmacro (cons defcc (cons defprolog (cons declare (cons datatype (cons datatypes (cons shen.ctxt (cons cn (cons cons? (cons cons (cons cond (cons concat (cons compile (cons cd (cons cases (cons call (cons close (cons bind (cons bound? (cons boolean? (cons boolean (cons bootstrap (cons (intern "bar!") (cons atom? (cons asserta (cons assertz (cons assoc (cons arity (cons append (cons and (cons adjoin (cons <-address (cons address-> (cons absvector? (cons absvector (cons absolute (cons abort ()))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) (value *property-vector*)) (set shen.*empty-absvector* (absvector 0))))))))))))))))))))))))))))))))))))))))))))) - -(defun shen.initialise-signedfuncs () (do (set shen.*sigf* ()) (do (set shen.*sigf* (shen.assoc-> abort (lambda V5951 (lambda B5947 (lambda L5948 (lambda Key5949 (lambda C5950 (let A (shen.newpv B5947) (shen.gc B5947 (is! V5951 (cons --> (cons A ())) B5947 L5948 Key5949 C5950)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> absolute (lambda V5956 (lambda B5952 (lambda L5953 (lambda Key5954 (lambda C5955 (is! V5956 (cons string (cons --> (cons (cons list (cons string ())) ()))) B5952 L5953 Key5954 C5955)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> absvector? (lambda V5961 (lambda B5957 (lambda L5958 (lambda Key5959 (lambda C5960 (let A (shen.newpv B5957) (shen.gc B5957 (is! V5961 (cons A (cons --> (cons boolean ()))) B5957 L5958 Key5959 C5960)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> adjoin (lambda V5966 (lambda B5962 (lambda L5963 (lambda Key5964 (lambda C5965 (let A (shen.newpv B5962) (shen.gc B5962 (is! V5966 (cons A (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons (cons list (cons A ())) ()))) ()))) B5962 L5963 Key5964 C5965)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> and (lambda V5971 (lambda B5967 (lambda L5968 (lambda Key5969 (lambda C5970 (is! V5971 (cons boolean (cons --> (cons (cons boolean (cons --> (cons boolean ()))) ()))) B5967 L5968 Key5969 C5970)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> shen.app (lambda V5976 (lambda B5972 (lambda L5973 (lambda Key5974 (lambda C5975 (let A (shen.newpv B5972) (shen.gc B5972 (is! V5976 (cons A (cons --> (cons (cons string (cons --> (cons (cons symbol (cons --> (cons string ()))) ()))) ()))) B5972 L5973 Key5974 C5975)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> append (lambda V5981 (lambda B5977 (lambda L5978 (lambda Key5979 (lambda C5980 (let A (shen.newpv B5977) (shen.gc B5977 (is! V5981 (cons (cons list (cons A ())) (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons (cons list (cons A ())) ()))) ()))) B5977 L5978 Key5979 C5980)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> arity (lambda V5986 (lambda B5982 (lambda L5983 (lambda Key5984 (lambda C5985 (let A (shen.newpv B5982) (shen.gc B5982 (is! V5986 (cons A (cons --> (cons number ()))) B5982 L5983 Key5984 C5985)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> assoc (lambda V5991 (lambda B5987 (lambda L5988 (lambda Key5989 (lambda C5990 (let A (shen.newpv B5987) (shen.gc B5987 (is! V5991 (cons A (cons --> (cons (cons (cons list (cons (cons list (cons A ())) ())) (cons --> (cons (cons list (cons A ())) ()))) ()))) B5987 L5988 Key5989 C5990)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> atom? (lambda V5996 (lambda B5992 (lambda L5993 (lambda Key5994 (lambda C5995 (let A (shen.newpv B5992) (shen.gc B5992 (is! V5996 (cons A (cons --> (cons boolean ()))) B5992 L5993 Key5994 C5995)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> boolean? (lambda V6001 (lambda B5997 (lambda L5998 (lambda Key5999 (lambda C6000 (let A (shen.newpv B5997) (shen.gc B5997 (is! V6001 (cons A (cons --> (cons boolean ()))) B5997 L5998 Key5999 C6000)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> bootstrap (lambda V6006 (lambda B6002 (lambda L6003 (lambda Key6004 (lambda C6005 (is! V6006 (cons string (cons --> (cons string ()))) B6002 L6003 Key6004 C6005)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> bound? (lambda V6011 (lambda B6007 (lambda L6008 (lambda Key6009 (lambda C6010 (is! V6011 (cons symbol (cons --> (cons boolean ()))) B6007 L6008 Key6009 C6010)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> shen.ccons? (lambda V6016 (lambda B6012 (lambda L6013 (lambda Key6014 (lambda C6015 (let A (shen.newpv B6012) (shen.gc B6012 (is! V6016 (cons (cons list (cons A ())) (cons --> (cons boolean ()))) B6012 L6013 Key6014 C6015)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> cd (lambda V6021 (lambda B6017 (lambda L6018 (lambda Key6019 (lambda C6020 (is! V6021 (cons string (cons --> (cons string ()))) B6017 L6018 Key6019 C6020)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> close (lambda V6026 (lambda B6022 (lambda L6023 (lambda Key6024 (lambda C6025 (let A (shen.newpv B6022) (shen.gc B6022 (let B (shen.newpv B6022) (shen.gc B6022 (is! V6026 (cons (cons stream (cons A ())) (cons --> (cons (cons list (cons B ())) ()))) B6022 L6023 Key6024 C6025)))))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> cn (lambda V6031 (lambda B6027 (lambda L6028 (lambda Key6029 (lambda C6030 (is! V6031 (cons string (cons --> (cons (cons string (cons --> (cons string ()))) ()))) B6027 L6028 Key6029 C6030)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> compile (lambda V6036 (lambda B6032 (lambda L6033 (lambda Key6034 (lambda C6035 (let A (shen.newpv B6032) (shen.gc B6032 (let B (shen.newpv B6032) (shen.gc B6032 (is! V6036 (cons (cons (cons list (cons A ())) (cons --> (cons (cons str (cons (cons list (cons A ())) (cons B ()))) ()))) (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons B ()))) ()))) B6032 L6033 Key6034 C6035)))))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> cons? (lambda V6041 (lambda B6037 (lambda L6038 (lambda Key6039 (lambda C6040 (let A (shen.newpv B6037) (shen.gc B6037 (is! V6041 (cons A (cons --> (cons boolean ()))) B6037 L6038 Key6039 C6040)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> datatypes (lambda V6046 (lambda B6042 (lambda L6043 (lambda Key6044 (lambda C6045 (is! V6046 (cons --> (cons (cons list (cons symbol ())) ())) B6042 L6043 Key6044 C6045)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> destroy (lambda V6051 (lambda B6047 (lambda L6048 (lambda Key6049 (lambda C6050 (is! V6051 (cons symbol (cons --> (cons symbol ()))) B6047 L6048 Key6049 C6050)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> difference (lambda V6056 (lambda B6052 (lambda L6053 (lambda Key6054 (lambda C6055 (let A (shen.newpv B6052) (shen.gc B6052 (is! V6056 (cons (cons list (cons A ())) (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons (cons list (cons A ())) ()))) ()))) B6052 L6053 Key6054 C6055)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> do (lambda V6061 (lambda B6057 (lambda L6058 (lambda Key6059 (lambda C6060 (let A (shen.newpv B6057) (shen.gc B6057 (let B (shen.newpv B6057) (shen.gc B6057 (is! V6061 (cons A (cons --> (cons (cons B (cons --> (cons B ()))) ()))) B6057 L6058 Key6059 C6060)))))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> (lambda V6066 (lambda B6062 (lambda L6063 (lambda Key6064 (lambda C6065 (let A (shen.newpv B6062) (shen.gc B6062 (let B (shen.newpv B6062) (shen.gc B6062 (is! V6066 (cons (cons list (cons A ())) (cons --> (cons (cons str (cons (cons list (cons A ())) (cons (cons list (cons B ())) ()))) ()))) B6062 L6063 Key6064 C6065)))))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> (lambda V6071 (lambda B6067 (lambda L6068 (lambda Key6069 (lambda C6070 (let B (shen.newpv B6067) (shen.gc B6067 (let A (shen.newpv B6067) (shen.gc B6067 (is! V6071 (cons (cons list (cons A ())) (cons --> (cons (cons str (cons (cons list (cons B ())) (cons (cons list (cons A ())) ()))) ()))) B6067 L6068 Key6069 C6070)))))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> (lambda V6076 (lambda B6072 (lambda L6073 (lambda Key6074 (lambda C6075 (let A (shen.newpv B6072) (shen.gc B6072 (let B (shen.newpv B6072) (shen.gc B6072 (is! V6076 (cons (cons list (cons A ())) (cons --> (cons (cons str (cons (cons list (cons A ())) (cons (cons list (cons B ())) ()))) ()))) B6072 L6073 Key6074 C6075)))))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> shen.parse-failure? (lambda V6081 (lambda B6077 (lambda L6078 (lambda Key6079 (lambda C6080 (let A (shen.newpv B6077) (shen.gc B6077 (let B (shen.newpv B6077) (shen.gc B6077 (is! V6081 (cons (cons str (cons (cons list (cons A ())) (cons B ()))) (cons --> (cons boolean ()))) B6077 L6078 Key6079 C6080)))))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> shen.parse-failure (lambda V6086 (lambda B6082 (lambda L6083 (lambda Key6084 (lambda C6085 (let A (shen.newpv B6082) (shen.gc B6082 (let B (shen.newpv B6082) (shen.gc B6082 (is! V6086 (cons --> (cons (cons str (cons (cons list (cons A ())) (cons B ()))) ())) B6082 L6083 Key6084 C6085)))))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> shen.<-out (lambda V6091 (lambda B6087 (lambda L6088 (lambda Key6089 (lambda C6090 (let A (shen.newpv B6087) (shen.gc B6087 (let B (shen.newpv B6087) (shen.gc B6087 (is! V6091 (cons (cons str (cons (cons list (cons A ())) (cons B ()))) (cons --> (cons B ()))) B6087 L6088 Key6089 C6090)))))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> shen.in-> (lambda V6096 (lambda B6092 (lambda L6093 (lambda Key6094 (lambda C6095 (let B (shen.newpv B6092) (shen.gc B6092 (let A (shen.newpv B6092) (shen.gc B6092 (is! V6096 (cons (cons str (cons (cons list (cons A ())) (cons B ()))) (cons --> (cons (cons list (cons A ())) ()))) B6092 L6093 Key6094 C6095)))))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> shen.comb (lambda V6101 (lambda B6097 (lambda L6098 (lambda Key6099 (lambda C6100 (let A (shen.newpv B6097) (shen.gc B6097 (let B (shen.newpv B6097) (shen.gc B6097 (is! V6101 (cons (cons list (cons A ())) (cons --> (cons (cons B (cons --> (cons (cons str (cons (cons list (cons A ())) (cons B ()))) ()))) ()))) B6097 L6098 Key6099 C6100)))))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> element? (lambda V6106 (lambda B6102 (lambda L6103 (lambda Key6104 (lambda C6105 (let A (shen.newpv B6102) (shen.gc B6102 (is! V6106 (cons A (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons boolean ()))) ()))) B6102 L6103 Key6104 C6105)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> empty? (lambda V6111 (lambda B6107 (lambda L6108 (lambda Key6109 (lambda C6110 (let A (shen.newpv B6107) (shen.gc B6107 (is! V6111 (cons A (cons --> (cons boolean ()))) B6107 L6108 Key6109 C6110)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> enable-type-theory (lambda V6116 (lambda B6112 (lambda L6113 (lambda Key6114 (lambda C6115 (is! V6116 (cons symbol (cons --> (cons boolean ()))) B6112 L6113 Key6114 C6115)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> external (lambda V6121 (lambda B6117 (lambda L6118 (lambda Key6119 (lambda C6120 (is! V6121 (cons symbol (cons --> (cons (cons list (cons symbol ())) ()))) B6117 L6118 Key6119 C6120)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> error-to-string (lambda V6126 (lambda B6122 (lambda L6123 (lambda Key6124 (lambda C6125 (is! V6126 (cons exception (cons --> (cons string ()))) B6122 L6123 Key6124 C6125)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> explode (lambda V6131 (lambda B6127 (lambda L6128 (lambda Key6129 (lambda C6130 (let A (shen.newpv B6127) (shen.gc B6127 (is! V6131 (cons A (cons --> (cons (cons list (cons string ())) ()))) B6127 L6128 Key6129 C6130)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> factorise (lambda V6136 (lambda B6132 (lambda L6133 (lambda Key6134 (lambda C6135 (is! V6136 (cons symbol (cons --> (cons symbol ()))) B6132 L6133 Key6134 C6135)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> factorise? (lambda V6141 (lambda B6137 (lambda L6138 (lambda Key6139 (lambda C6140 (is! V6141 (cons --> (cons boolean ())) B6137 L6138 Key6139 C6140)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> fail (lambda V6146 (lambda B6142 (lambda L6143 (lambda Key6144 (lambda C6145 (is! V6146 (cons --> (cons symbol ())) B6142 L6143 Key6144 C6145)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> fix (lambda V6151 (lambda B6147 (lambda L6148 (lambda Key6149 (lambda C6150 (let A (shen.newpv B6147) (shen.gc B6147 (is! V6151 (cons (cons A (cons --> (cons A ()))) (cons --> (cons (cons A (cons --> (cons A ()))) ()))) B6147 L6148 Key6149 C6150)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> freeze (lambda V6156 (lambda B6152 (lambda L6153 (lambda Key6154 (lambda C6155 (let A (shen.newpv B6152) (shen.gc B6152 (is! V6156 (cons A (cons --> (cons (cons lazy (cons A ())) ()))) B6152 L6153 Key6154 C6155)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> fst (lambda V6161 (lambda B6157 (lambda L6158 (lambda Key6159 (lambda C6160 (let B (shen.newpv B6157) (shen.gc B6157 (let A (shen.newpv B6157) (shen.gc B6157 (is! V6161 (cons (cons A (cons * (cons B ()))) (cons --> (cons A ()))) B6157 L6158 Key6159 C6160)))))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> gensym (lambda V6166 (lambda B6162 (lambda L6163 (lambda Key6164 (lambda C6165 (is! V6166 (cons symbol (cons --> (cons symbol ()))) B6162 L6163 Key6164 C6165)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> shen.hds=? (lambda V6171 (lambda B6167 (lambda L6168 (lambda Key6169 (lambda C6170 (let A (shen.newpv B6167) (shen.gc B6167 (is! V6171 (cons (cons list (cons A ())) (cons --> (cons (cons A (cons --> (cons boolean ()))) ()))) B6167 L6168 Key6169 C6170)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> hush (lambda V6176 (lambda B6172 (lambda L6173 (lambda Key6174 (lambda C6175 (is! V6176 (cons symbol (cons --> (cons boolean ()))) B6172 L6173 Key6174 C6175)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> hush? (lambda V6181 (lambda B6177 (lambda L6178 (lambda Key6179 (lambda C6180 (is! V6181 (cons --> (cons boolean ())) B6177 L6178 Key6179 C6180)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> <-vector (lambda V6186 (lambda B6182 (lambda L6183 (lambda Key6184 (lambda C6185 (let A (shen.newpv B6182) (shen.gc B6182 (is! V6186 (cons (cons vector (cons A ())) (cons --> (cons (cons number (cons --> (cons A ()))) ()))) B6182 L6183 Key6184 C6185)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> vector-> (lambda V6191 (lambda B6187 (lambda L6188 (lambda Key6189 (lambda C6190 (let A (shen.newpv B6187) (shen.gc B6187 (is! V6191 (cons (cons vector (cons A ())) (cons --> (cons (cons number (cons --> (cons (cons A (cons --> (cons (cons vector (cons A ())) ()))) ()))) ()))) B6187 L6188 Key6189 C6190)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> vector (lambda V6196 (lambda B6192 (lambda L6193 (lambda Key6194 (lambda C6195 (let A (shen.newpv B6192) (shen.gc B6192 (is! V6196 (cons number (cons --> (cons (cons vector (cons A ())) ()))) B6192 L6193 Key6194 C6195)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> get-time (lambda V6201 (lambda B6197 (lambda L6198 (lambda Key6199 (lambda C6200 (is! V6201 (cons symbol (cons --> (cons number ()))) B6197 L6198 Key6199 C6200)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> hash (lambda V6206 (lambda B6202 (lambda L6203 (lambda Key6204 (lambda C6205 (let A (shen.newpv B6202) (shen.gc B6202 (is! V6206 (cons A (cons --> (cons (cons number (cons --> (cons number ()))) ()))) B6202 L6203 Key6204 C6205)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> head (lambda V6211 (lambda B6207 (lambda L6208 (lambda Key6209 (lambda C6210 (let A (shen.newpv B6207) (shen.gc B6207 (is! V6211 (cons (cons list (cons A ())) (cons --> (cons A ()))) B6207 L6208 Key6209 C6210)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> hdv (lambda V6216 (lambda B6212 (lambda L6213 (lambda Key6214 (lambda C6215 (let A (shen.newpv B6212) (shen.gc B6212 (is! V6216 (cons (cons vector (cons A ())) (cons --> (cons A ()))) B6212 L6213 Key6214 C6215)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> hdstr (lambda V6221 (lambda B6217 (lambda L6218 (lambda Key6219 (lambda C6220 (is! V6221 (cons string (cons --> (cons string ()))) B6217 L6218 Key6219 C6220)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> if (lambda V6226 (lambda B6222 (lambda L6223 (lambda Key6224 (lambda C6225 (let A (shen.newpv B6222) (shen.gc B6222 (is! V6226 (cons boolean (cons --> (cons (cons A (cons --> (cons (cons A (cons --> (cons A ()))) ()))) ()))) B6222 L6223 Key6224 C6225)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> in-package (lambda V6231 (lambda B6227 (lambda L6228 (lambda Key6229 (lambda C6230 (is! V6231 (cons symbol (cons --> (cons symbol ()))) B6227 L6228 Key6229 C6230)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> it (lambda V6236 (lambda B6232 (lambda L6233 (lambda Key6234 (lambda C6235 (is! V6236 (cons --> (cons string ())) B6232 L6233 Key6234 C6235)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> implementation (lambda V6241 (lambda B6237 (lambda L6238 (lambda Key6239 (lambda C6240 (is! V6241 (cons --> (cons string ())) B6237 L6238 Key6239 C6240)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> include (lambda V6246 (lambda B6242 (lambda L6243 (lambda Key6244 (lambda C6245 (is! V6246 (cons (cons list (cons symbol ())) (cons --> (cons (cons list (cons symbol ())) ()))) B6242 L6243 Key6244 C6245)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> include-all-but (lambda V6251 (lambda B6247 (lambda L6248 (lambda Key6249 (lambda C6250 (is! V6251 (cons (cons list (cons symbol ())) (cons --> (cons (cons list (cons symbol ())) ()))) B6247 L6248 Key6249 C6250)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> included (lambda V6256 (lambda B6252 (lambda L6253 (lambda Key6254 (lambda C6255 (is! V6256 (cons --> (cons (cons list (cons symbol ())) ())) B6252 L6253 Key6254 C6255)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> inferences (lambda V6261 (lambda B6257 (lambda L6258 (lambda Key6259 (lambda C6260 (is! V6261 (cons --> (cons number ())) B6257 L6258 Key6259 C6260)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> shen.insert (lambda V6266 (lambda B6262 (lambda L6263 (lambda Key6264 (lambda C6265 (let A (shen.newpv B6262) (shen.gc B6262 (is! V6266 (cons A (cons --> (cons (cons string (cons --> (cons string ()))) ()))) B6262 L6263 Key6264 C6265)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> integer? (lambda V6271 (lambda B6267 (lambda L6268 (lambda Key6269 (lambda C6270 (let A (shen.newpv B6267) (shen.gc B6267 (is! V6271 (cons A (cons --> (cons boolean ()))) B6267 L6268 Key6269 C6270)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> internal (lambda V6276 (lambda B6272 (lambda L6273 (lambda Key6274 (lambda C6275 (is! V6276 (cons symbol (cons --> (cons (cons list (cons symbol ())) ()))) B6272 L6273 Key6274 C6275)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> intersection (lambda V6281 (lambda B6277 (lambda L6278 (lambda Key6279 (lambda C6280 (let A (shen.newpv B6277) (shen.gc B6277 (is! V6281 (cons (cons list (cons A ())) (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons (cons list (cons A ())) ()))) ()))) B6277 L6278 Key6279 C6280)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> language (lambda V6286 (lambda B6282 (lambda L6283 (lambda Key6284 (lambda C6285 (is! V6286 (cons --> (cons string ())) B6282 L6283 Key6284 C6285)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> length (lambda V6291 (lambda B6287 (lambda L6288 (lambda Key6289 (lambda C6290 (let A (shen.newpv B6287) (shen.gc B6287 (is! V6291 (cons (cons list (cons A ())) (cons --> (cons number ()))) B6287 L6288 Key6289 C6290)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> limit (lambda V6296 (lambda B6292 (lambda L6293 (lambda Key6294 (lambda C6295 (let A (shen.newpv B6292) (shen.gc B6292 (is! V6296 (cons (cons vector (cons A ())) (cons --> (cons number ()))) B6292 L6293 Key6294 C6295)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> lineread (lambda V6301 (lambda B6297 (lambda L6298 (lambda Key6299 (lambda C6300 (is! V6301 (cons (cons stream (cons in ())) (cons --> (cons (cons list (cons unit ())) ()))) B6297 L6298 Key6299 C6300)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> load (lambda V6306 (lambda B6302 (lambda L6303 (lambda Key6304 (lambda C6305 (is! V6306 (cons string (cons --> (cons symbol ()))) B6302 L6303 Key6304 C6305)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> map (lambda V6311 (lambda B6307 (lambda L6308 (lambda Key6309 (lambda C6310 (let A (shen.newpv B6307) (shen.gc B6307 (let B (shen.newpv B6307) (shen.gc B6307 (is! V6311 (cons (cons A (cons --> (cons B ()))) (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons (cons list (cons B ())) ()))) ()))) B6307 L6308 Key6309 C6310)))))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> mapcan (lambda V6316 (lambda B6312 (lambda L6313 (lambda Key6314 (lambda C6315 (let A (shen.newpv B6312) (shen.gc B6312 (let B (shen.newpv B6312) (shen.gc B6312 (is! V6316 (cons (cons A (cons --> (cons (cons list (cons B ())) ()))) (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons (cons list (cons B ())) ()))) ()))) B6312 L6313 Key6314 C6315)))))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> maxinferences (lambda V6321 (lambda B6317 (lambda L6318 (lambda Key6319 (lambda C6320 (is! V6321 (cons number (cons --> (cons number ()))) B6317 L6318 Key6319 C6320)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> n->string (lambda V6326 (lambda B6322 (lambda L6323 (lambda Key6324 (lambda C6325 (is! V6326 (cons number (cons --> (cons string ()))) B6322 L6323 Key6324 C6325)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> nl (lambda V6331 (lambda B6327 (lambda L6328 (lambda Key6329 (lambda C6330 (is! V6331 (cons number (cons --> (cons number ()))) B6327 L6328 Key6329 C6330)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> not (lambda V6336 (lambda B6332 (lambda L6333 (lambda Key6334 (lambda C6335 (is! V6336 (cons boolean (cons --> (cons boolean ()))) B6332 L6333 Key6334 C6335)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> nth (lambda V6341 (lambda B6337 (lambda L6338 (lambda Key6339 (lambda C6340 (let A (shen.newpv B6337) (shen.gc B6337 (is! V6341 (cons number (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons A ()))) ()))) B6337 L6338 Key6339 C6340)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> number? (lambda V6346 (lambda B6342 (lambda L6343 (lambda Key6344 (lambda C6345 (let A (shen.newpv B6342) (shen.gc B6342 (is! V6346 (cons A (cons --> (cons boolean ()))) B6342 L6343 Key6344 C6345)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> occurrences (lambda V6351 (lambda B6347 (lambda L6348 (lambda Key6349 (lambda C6350 (let A (shen.newpv B6347) (shen.gc B6347 (let B (shen.newpv B6347) (shen.gc B6347 (is! V6351 (cons A (cons --> (cons (cons B (cons --> (cons number ()))) ()))) B6347 L6348 Key6349 C6350)))))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> occurs-check (lambda V6356 (lambda B6352 (lambda L6353 (lambda Key6354 (lambda C6355 (is! V6356 (cons symbol (cons --> (cons boolean ()))) B6352 L6353 Key6354 C6355)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> occurs? (lambda V6361 (lambda B6357 (lambda L6358 (lambda Key6359 (lambda C6360 (is! V6361 (cons --> (cons boolean ())) B6357 L6358 Key6359 C6360)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> optimise (lambda V6366 (lambda B6362 (lambda L6363 (lambda Key6364 (lambda C6365 (is! V6366 (cons symbol (cons --> (cons boolean ()))) B6362 L6363 Key6364 C6365)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> optimise? (lambda V6371 (lambda B6367 (lambda L6368 (lambda Key6369 (lambda C6370 (is! V6371 (cons --> (cons boolean ())) B6367 L6368 Key6369 C6370)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> or (lambda V6376 (lambda B6372 (lambda L6373 (lambda Key6374 (lambda C6375 (is! V6376 (cons boolean (cons --> (cons (cons boolean (cons --> (cons boolean ()))) ()))) B6372 L6373 Key6374 C6375)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> os (lambda V6381 (lambda B6377 (lambda L6378 (lambda Key6379 (lambda C6380 (is! V6381 (cons --> (cons string ())) B6377 L6378 Key6379 C6380)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> package? (lambda V6386 (lambda B6382 (lambda L6383 (lambda Key6384 (lambda C6385 (is! V6386 (cons symbol (cons --> (cons boolean ()))) B6382 L6383 Key6384 C6385)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> port (lambda V6391 (lambda B6387 (lambda L6388 (lambda Key6389 (lambda C6390 (is! V6391 (cons --> (cons string ())) B6387 L6388 Key6389 C6390)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> porters (lambda V6396 (lambda B6392 (lambda L6393 (lambda Key6394 (lambda C6395 (is! V6396 (cons --> (cons string ())) B6392 L6393 Key6394 C6395)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> pos (lambda V6401 (lambda B6397 (lambda L6398 (lambda Key6399 (lambda C6400 (is! V6401 (cons string (cons --> (cons (cons number (cons --> (cons string ()))) ()))) B6397 L6398 Key6399 C6400)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> pr (lambda V6406 (lambda B6402 (lambda L6403 (lambda Key6404 (lambda C6405 (is! V6406 (cons string (cons --> (cons (cons (cons stream (cons out ())) (cons --> (cons string ()))) ()))) B6402 L6403 Key6404 C6405)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> print (lambda V6411 (lambda B6407 (lambda L6408 (lambda Key6409 (lambda C6410 (let A (shen.newpv B6407) (shen.gc B6407 (is! V6411 (cons A (cons --> (cons A ()))) B6407 L6408 Key6409 C6410)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> profile (lambda V6416 (lambda B6412 (lambda L6413 (lambda Key6414 (lambda C6415 (is! V6416 (cons symbol (cons --> (cons symbol ()))) B6412 L6413 Key6414 C6415)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> preclude (lambda V6421 (lambda B6417 (lambda L6418 (lambda Key6419 (lambda C6420 (is! V6421 (cons (cons list (cons symbol ())) (cons --> (cons (cons list (cons symbol ())) ()))) B6417 L6418 Key6419 C6420)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> shen.proc-nl (lambda V6426 (lambda B6422 (lambda L6423 (lambda Key6424 (lambda C6425 (is! V6426 (cons string (cons --> (cons string ()))) B6422 L6423 Key6424 C6425)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> profile-results (lambda V6431 (lambda B6427 (lambda L6428 (lambda Key6429 (lambda C6430 (is! V6431 (cons symbol (cons --> (cons (cons symbol (cons * (cons number ()))) ()))) B6427 L6428 Key6429 C6430)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> protect (lambda V6436 (lambda B6432 (lambda L6433 (lambda Key6434 (lambda C6435 (let A (shen.newpv B6432) (shen.gc B6432 (is! V6436 (cons A (cons --> (cons A ()))) B6432 L6433 Key6434 C6435)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> preclude-all-but (lambda V6441 (lambda B6437 (lambda L6438 (lambda Key6439 (lambda C6440 (is! V6441 (cons (cons list (cons symbol ())) (cons --> (cons (cons list (cons symbol ())) ()))) B6437 L6438 Key6439 C6440)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> shen.prhush (lambda V6446 (lambda B6442 (lambda L6443 (lambda Key6444 (lambda C6445 (is! V6446 (cons string (cons --> (cons (cons (cons stream (cons out ())) (cons --> (cons string ()))) ()))) B6442 L6443 Key6444 C6445)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> prolog-memory (lambda V6451 (lambda B6447 (lambda L6448 (lambda Key6449 (lambda C6450 (is! V6451 (cons number (cons --> (cons number ()))) B6447 L6448 Key6449 C6450)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> ps (lambda V6456 (lambda B6452 (lambda L6453 (lambda Key6454 (lambda C6455 (is! V6456 (cons symbol (cons --> (cons (cons list (cons unit ())) ()))) B6452 L6453 Key6454 C6455)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> read (lambda V6461 (lambda B6457 (lambda L6458 (lambda Key6459 (lambda C6460 (is! V6461 (cons (cons stream (cons in ())) (cons --> (cons unit ()))) B6457 L6458 Key6459 C6460)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> read-byte (lambda V6466 (lambda B6462 (lambda L6463 (lambda Key6464 (lambda C6465 (is! V6466 (cons (cons stream (cons in ())) (cons --> (cons number ()))) B6462 L6463 Key6464 C6465)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> read-file-as-bytelist (lambda V6471 (lambda B6467 (lambda L6468 (lambda Key6469 (lambda C6470 (is! V6471 (cons string (cons --> (cons (cons list (cons number ())) ()))) B6467 L6468 Key6469 C6470)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> read-file-as-string (lambda V6476 (lambda B6472 (lambda L6473 (lambda Key6474 (lambda C6475 (is! V6476 (cons string (cons --> (cons string ()))) B6472 L6473 Key6474 C6475)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> read-file (lambda V6481 (lambda B6477 (lambda L6478 (lambda Key6479 (lambda C6480 (is! V6481 (cons string (cons --> (cons (cons list (cons unit ())) ()))) B6477 L6478 Key6479 C6480)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> read-from-string (lambda V6486 (lambda B6482 (lambda L6483 (lambda Key6484 (lambda C6485 (is! V6486 (cons string (cons --> (cons (cons list (cons unit ())) ()))) B6482 L6483 Key6484 C6485)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> read-from-string-unprocessed (lambda V6491 (lambda B6487 (lambda L6488 (lambda Key6489 (lambda C6490 (is! V6491 (cons string (cons --> (cons (cons list (cons unit ())) ()))) B6487 L6488 Key6489 C6490)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> release (lambda V6496 (lambda B6492 (lambda L6493 (lambda Key6494 (lambda C6495 (is! V6496 (cons --> (cons string ())) B6492 L6493 Key6494 C6495)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> remove (lambda V6501 (lambda B6497 (lambda L6498 (lambda Key6499 (lambda C6500 (let A (shen.newpv B6497) (shen.gc B6497 (is! V6501 (cons A (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons (cons list (cons A ())) ()))) ()))) B6497 L6498 Key6499 C6500)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> reverse (lambda V6506 (lambda B6502 (lambda L6503 (lambda Key6504 (lambda C6505 (let A (shen.newpv B6502) (shen.gc B6502 (is! V6506 (cons (cons list (cons A ())) (cons --> (cons (cons list (cons A ())) ()))) B6502 L6503 Key6504 C6505)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> simple-error (lambda V6511 (lambda B6507 (lambda L6508 (lambda Key6509 (lambda C6510 (let A (shen.newpv B6507) (shen.gc B6507 (is! V6511 (cons string (cons --> (cons A ()))) B6507 L6508 Key6509 C6510)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> snd (lambda V6516 (lambda B6512 (lambda L6513 (lambda Key6514 (lambda C6515 (let A (shen.newpv B6512) (shen.gc B6512 (let B (shen.newpv B6512) (shen.gc B6512 (is! V6516 (cons (cons A (cons * (cons B ()))) (cons --> (cons B ()))) B6512 L6513 Key6514 C6515)))))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> specialise (lambda V6521 (lambda B6517 (lambda L6518 (lambda Key6519 (lambda C6520 (is! V6521 (cons symbol (cons --> (cons (cons number (cons --> (cons symbol ()))) ()))) B6517 L6518 Key6519 C6520)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> spy (lambda V6526 (lambda B6522 (lambda L6523 (lambda Key6524 (lambda C6525 (is! V6526 (cons symbol (cons --> (cons boolean ()))) B6522 L6523 Key6524 C6525)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> shen.spy? (lambda V6531 (lambda B6527 (lambda L6528 (lambda Key6529 (lambda C6530 (is! V6531 (cons --> (cons boolean ())) B6527 L6528 Key6529 C6530)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> step (lambda V6536 (lambda B6532 (lambda L6533 (lambda Key6534 (lambda C6535 (is! V6536 (cons symbol (cons --> (cons boolean ()))) B6532 L6533 Key6534 C6535)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> shen.step? (lambda V6541 (lambda B6537 (lambda L6538 (lambda Key6539 (lambda C6540 (is! V6541 (cons --> (cons boolean ())) B6537 L6538 Key6539 C6540)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> stinput (lambda V6546 (lambda B6542 (lambda L6543 (lambda Key6544 (lambda C6545 (is! V6546 (cons --> (cons (cons stream (cons in ())) ())) B6542 L6543 Key6544 C6545)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> sterror (lambda V6551 (lambda B6547 (lambda L6548 (lambda Key6549 (lambda C6550 (is! V6551 (cons --> (cons (cons stream (cons out ())) ())) B6547 L6548 Key6549 C6550)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> stoutput (lambda V6556 (lambda B6552 (lambda L6553 (lambda Key6554 (lambda C6555 (is! V6556 (cons --> (cons (cons stream (cons out ())) ())) B6552 L6553 Key6554 C6555)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> string? (lambda V6561 (lambda B6557 (lambda L6558 (lambda Key6559 (lambda C6560 (let A (shen.newpv B6557) (shen.gc B6557 (is! V6561 (cons A (cons --> (cons boolean ()))) B6557 L6558 Key6559 C6560)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> str (lambda V6566 (lambda B6562 (lambda L6563 (lambda Key6564 (lambda C6565 (let A (shen.newpv B6562) (shen.gc B6562 (is! V6566 (cons A (cons --> (cons string ()))) B6562 L6563 Key6564 C6565)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> string->n (lambda V6571 (lambda B6567 (lambda L6568 (lambda Key6569 (lambda C6570 (is! V6571 (cons string (cons --> (cons number ()))) B6567 L6568 Key6569 C6570)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> string->symbol (lambda V6576 (lambda B6572 (lambda L6573 (lambda Key6574 (lambda C6575 (is! V6576 (cons string (cons --> (cons symbol ()))) B6572 L6573 Key6574 C6575)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> sum (lambda V6581 (lambda B6577 (lambda L6578 (lambda Key6579 (lambda C6580 (is! V6581 (cons (cons list (cons number ())) (cons --> (cons number ()))) B6577 L6578 Key6579 C6580)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> symbol? (lambda V6586 (lambda B6582 (lambda L6583 (lambda Key6584 (lambda C6585 (let A (shen.newpv B6582) (shen.gc B6582 (is! V6586 (cons A (cons --> (cons boolean ()))) B6582 L6583 Key6584 C6585)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> systemf (lambda V6591 (lambda B6587 (lambda L6588 (lambda Key6589 (lambda C6590 (is! V6591 (cons symbol (cons --> (cons symbol ()))) B6587 L6588 Key6589 C6590)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> system-S? (lambda V6596 (lambda B6592 (lambda L6593 (lambda Key6594 (lambda C6595 (is! V6596 (cons --> (cons boolean ())) B6592 L6593 Key6594 C6595)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> tail (lambda V6601 (lambda B6597 (lambda L6598 (lambda Key6599 (lambda C6600 (let A (shen.newpv B6597) (shen.gc B6597 (is! V6601 (cons (cons list (cons A ())) (cons --> (cons (cons list (cons A ())) ()))) B6597 L6598 Key6599 C6600)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> tlstr (lambda V6606 (lambda B6602 (lambda L6603 (lambda Key6604 (lambda C6605 (is! V6606 (cons string (cons --> (cons string ()))) B6602 L6603 Key6604 C6605)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> tlv (lambda V6611 (lambda B6607 (lambda L6608 (lambda Key6609 (lambda C6610 (let A (shen.newpv B6607) (shen.gc B6607 (is! V6611 (cons (cons vector (cons A ())) (cons --> (cons (cons vector (cons A ())) ()))) B6607 L6608 Key6609 C6610)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> tc (lambda V6616 (lambda B6612 (lambda L6613 (lambda Key6614 (lambda C6615 (is! V6616 (cons symbol (cons --> (cons boolean ()))) B6612 L6613 Key6614 C6615)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> tc? (lambda V6621 (lambda B6617 (lambda L6618 (lambda Key6619 (lambda C6620 (is! V6621 (cons --> (cons boolean ())) B6617 L6618 Key6619 C6620)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> thaw (lambda V6626 (lambda B6622 (lambda L6623 (lambda Key6624 (lambda C6625 (let A (shen.newpv B6622) (shen.gc B6622 (is! V6626 (cons (cons lazy (cons A ())) (cons --> (cons A ()))) B6622 L6623 Key6624 C6625)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> track (lambda V6631 (lambda B6627 (lambda L6628 (lambda Key6629 (lambda C6630 (is! V6631 (cons symbol (cons --> (cons symbol ()))) B6627 L6628 Key6629 C6630)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> tracked (lambda V6636 (lambda B6632 (lambda L6633 (lambda Key6634 (lambda C6635 (is! V6636 (cons --> (cons (cons list (cons symbol ())) ())) B6632 L6633 Key6634 C6635)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> trap-error (lambda V6641 (lambda B6637 (lambda L6638 (lambda Key6639 (lambda C6640 (let A (shen.newpv B6637) (shen.gc B6637 (is! V6641 (cons A (cons --> (cons (cons (cons exception (cons --> (cons A ()))) (cons --> (cons A ()))) ()))) B6637 L6638 Key6639 C6640)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> tuple? (lambda V6646 (lambda B6642 (lambda L6643 (lambda Key6644 (lambda C6645 (let A (shen.newpv B6642) (shen.gc B6642 (is! V6646 (cons A (cons --> (cons boolean ()))) B6642 L6643 Key6644 C6645)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> unabsolute (lambda V6651 (lambda B6647 (lambda L6648 (lambda Key6649 (lambda C6650 (is! V6651 (cons string (cons --> (cons (cons list (cons string ())) ()))) B6647 L6648 Key6649 C6650)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> undefmacro (lambda V6656 (lambda B6652 (lambda L6653 (lambda Key6654 (lambda C6655 (is! V6656 (cons symbol (cons --> (cons symbol ()))) B6652 L6653 Key6654 C6655)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> union (lambda V6661 (lambda B6657 (lambda L6658 (lambda Key6659 (lambda C6660 (let A (shen.newpv B6657) (shen.gc B6657 (is! V6661 (cons (cons list (cons A ())) (cons --> (cons (cons (cons list (cons A ())) (cons --> (cons (cons list (cons A ())) ()))) ()))) B6657 L6658 Key6659 C6660)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> unprofile (lambda V6666 (lambda B6662 (lambda L6663 (lambda Key6664 (lambda C6665 (is! V6666 (cons symbol (cons --> (cons symbol ()))) B6662 L6663 Key6664 C6665)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> untrack (lambda V6671 (lambda B6667 (lambda L6668 (lambda Key6669 (lambda C6670 (is! V6671 (cons symbol (cons --> (cons symbol ()))) B6667 L6668 Key6669 C6670)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> userdefs (lambda V6676 (lambda B6672 (lambda L6673 (lambda Key6674 (lambda C6675 (is! V6676 (cons --> (cons (cons list (cons symbol ())) ())) B6672 L6673 Key6674 C6675)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> variable? (lambda V6681 (lambda B6677 (lambda L6678 (lambda Key6679 (lambda C6680 (let A (shen.newpv B6677) (shen.gc B6677 (is! V6681 (cons A (cons --> (cons boolean ()))) B6677 L6678 Key6679 C6680)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> vector? (lambda V6686 (lambda B6682 (lambda L6683 (lambda Key6684 (lambda C6685 (let A (shen.newpv B6682) (shen.gc B6682 (is! V6686 (cons A (cons --> (cons boolean ()))) B6682 L6683 Key6684 C6685)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> version (lambda V6691 (lambda B6687 (lambda L6688 (lambda Key6689 (lambda C6690 (is! V6691 (cons --> (cons string ())) B6687 L6688 Key6689 C6690)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> write-to-file (lambda V6696 (lambda B6692 (lambda L6693 (lambda Key6694 (lambda C6695 (let A (shen.newpv B6692) (shen.gc B6692 (is! V6696 (cons string (cons --> (cons (cons A (cons --> (cons A ()))) ()))) B6692 L6693 Key6694 C6695)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> write-byte (lambda V6701 (lambda B6697 (lambda L6698 (lambda Key6699 (lambda C6700 (is! V6701 (cons number (cons --> (cons (cons (cons stream (cons out ())) (cons --> (cons number ()))) ()))) B6697 L6698 Key6699 C6700)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> y-or-n? (lambda V6706 (lambda B6702 (lambda L6703 (lambda Key6704 (lambda C6705 (is! V6706 (cons string (cons --> (cons boolean ()))) B6702 L6703 Key6704 C6705)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> > (lambda V6711 (lambda B6707 (lambda L6708 (lambda Key6709 (lambda C6710 (is! V6711 (cons number (cons --> (cons (cons number (cons --> (cons boolean ()))) ()))) B6707 L6708 Key6709 C6710)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> < (lambda V6716 (lambda B6712 (lambda L6713 (lambda Key6714 (lambda C6715 (is! V6716 (cons number (cons --> (cons (cons number (cons --> (cons boolean ()))) ()))) B6712 L6713 Key6714 C6715)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> >= (lambda V6721 (lambda B6717 (lambda L6718 (lambda Key6719 (lambda C6720 (is! V6721 (cons number (cons --> (cons (cons number (cons --> (cons boolean ()))) ()))) B6717 L6718 Key6719 C6720)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> <= (lambda V6726 (lambda B6722 (lambda L6723 (lambda Key6724 (lambda C6725 (is! V6726 (cons number (cons --> (cons (cons number (cons --> (cons boolean ()))) ()))) B6722 L6723 Key6724 C6725)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> = (lambda V6731 (lambda B6727 (lambda L6728 (lambda Key6729 (lambda C6730 (let A (shen.newpv B6727) (shen.gc B6727 (is! V6731 (cons A (cons --> (cons (cons A (cons --> (cons boolean ()))) ()))) B6727 L6728 Key6729 C6730)))))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> + (lambda V6736 (lambda B6732 (lambda L6733 (lambda Key6734 (lambda C6735 (is! V6736 (cons number (cons --> (cons (cons number (cons --> (cons number ()))) ()))) B6732 L6733 Key6734 C6735)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> / (lambda V6741 (lambda B6737 (lambda L6738 (lambda Key6739 (lambda C6740 (is! V6741 (cons number (cons --> (cons (cons number (cons --> (cons number ()))) ()))) B6737 L6738 Key6739 C6740)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> - (lambda V6746 (lambda B6742 (lambda L6743 (lambda Key6744 (lambda C6745 (is! V6746 (cons number (cons --> (cons (cons number (cons --> (cons number ()))) ()))) B6742 L6743 Key6744 C6745)))))) (value shen.*sigf*))) (do (set shen.*sigf* (shen.assoc-> * (lambda V6751 (lambda B6747 (lambda L6748 (lambda Key6749 (lambda C6750 (is! V6751 (cons number (cons --> (cons (cons number (cons --> (cons number ()))) ()))) B6747 L6748 Key6749 C6750)))))) (value shen.*sigf*))) (set shen.*sigf* (shen.assoc-> == (lambda V6756 (lambda B6752 (lambda L6753 (lambda Key6754 (lambda C6755 (let A (shen.newpv B6752) (shen.gc B6752 (let B (shen.newpv B6752) (shen.gc B6752 (is! V6756 (cons A (cons --> (cons (cons B (cons --> (cons boolean ()))) ()))) B6752 L6753 Key6754 C6755)))))))))) (value shen.*sigf*)))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) - -(defun shen.initialise-lambda-forms () (do (shen.set-lambda-form-entry (cons shen.tuple (lambda Y1220 (shen.tuple Y1220)))) (do (shen.set-lambda-form-entry (cons shen.pvar (lambda Y1219 (shen.pvar Y1219)))) (do (shen.set-lambda-form-entry (cons shen.dictionary (lambda Y1218 (shen.dictionary Y1218)))) (do (shen.set-lambda-form-entry (cons shen.print-prolog-vector (lambda Y1217 (shen.print-prolog-vector Y1217)))) (do (shen.set-lambda-form-entry (cons shen.print-freshterm (lambda Y1216 (shen.print-freshterm Y1216)))) (do (shen.set-lambda-form-entry (cons shen.printF (lambda Y1215 (shen.printF Y1215)))) (do (shen.set-lambda-form-entry (cons adjoin (lambda Y1207 (lambda Y1208 (adjoin Y1207 Y1208))))) (do (shen.set-lambda-form-entry (cons and (lambda Y1205 (lambda Y1206 (and Y1205 Y1206))))) (do (shen.set-lambda-form-entry (cons append (lambda Y1203 (lambda Y1204 (append Y1203 Y1204))))) (do (shen.set-lambda-form-entry (cons arity (lambda Y1202 (arity Y1202)))) (do (shen.set-lambda-form-entry (cons assoc (lambda Y1200 (lambda Y1201 (assoc Y1200 Y1201))))) (do (shen.set-lambda-form-entry (cons atom? (lambda Y1199 (atom? Y1199)))) (do (shen.set-lambda-form-entry (cons boolean? (lambda Y1198 (boolean? Y1198)))) (do (shen.set-lambda-form-entry (cons bound? (lambda Y1196 (bound? Y1196)))) (do (shen.set-lambda-form-entry (cons bind (lambda Y1190 (lambda Y1191 (lambda Y1192 (lambda Y1193 (lambda Y1194 (lambda Y1195 (bind Y1190 Y1191 Y1192 Y1193 Y1194 Y1195))))))))) (do (shen.set-lambda-form-entry (cons call (lambda Y1185 (lambda Y1186 (lambda Y1187 (lambda Y1188 (lambda Y1189 (call Y1185 Y1186 Y1187 Y1188 Y1189)))))))) (do (shen.set-lambda-form-entry (cons compile (lambda Y1182 (lambda Y1183 (compile Y1182 Y1183))))) (do (shen.set-lambda-form-entry (cons concat (lambda Y1180 (lambda Y1181 (concat Y1180 Y1181))))) (do (shen.set-lambda-form-entry (cons cons (lambda Y1178 (lambda Y1179 (cons Y1178 Y1179))))) (do (shen.set-lambda-form-entry (cons cons? (lambda Y1177 (cons? Y1177)))) (do (shen.set-lambda-form-entry (cons cn (lambda Y1175 (lambda Y1176 (cn Y1175 Y1176))))) (do (shen.set-lambda-form-entry (cons declare (lambda Y1172 (lambda Y1173 (declare Y1172 Y1173))))) (do (shen.set-lambda-form-entry (cons destroy (lambda Y1171 (destroy Y1171)))) (do (shen.set-lambda-form-entry (cons difference (lambda Y1169 (lambda Y1170 (difference Y1169 Y1170))))) (do (shen.set-lambda-form-entry (cons do (lambda Y1167 (lambda Y1168 (do Y1167 Y1168))))) (do (shen.set-lambda-form-entry (cons element? (lambda Y1165 (lambda Y1166 (element? Y1165 Y1166))))) (do (shen.set-lambda-form-entry (cons empty? (lambda Y1164 (empty? Y1164)))) (do (shen.set-lambda-form-entry (cons external (lambda Y1162 (external Y1162)))) (do (shen.set-lambda-form-entry (cons eval (lambda Y1160 (eval Y1160)))) (do (shen.set-lambda-form-entry (cons explode (lambda Y1158 (explode Y1158)))) (do (shen.set-lambda-form-entry (cons external (lambda Y1157 (external Y1157)))) (do (shen.set-lambda-form-entry (cons fail-if (lambda Y1154 (lambda Y1155 (fail-if Y1154 Y1155))))) (do (shen.set-lambda-form-entry (cons fork (lambda Y1140 (lambda Y1141 (lambda Y1142 (lambda Y1143 (lambda Y1144 (fork Y1140 Y1141 Y1142 Y1143 Y1144)))))))) (do (shen.set-lambda-form-entry (cons freeze (lambda Y1139 (freeze Y1139)))) (do (shen.set-lambda-form-entry (cons fst (lambda Y1138 (fst Y1138)))) (do (shen.set-lambda-form-entry (cons fn (lambda Y1137 (fn Y1137)))) (do (shen.set-lambda-form-entry (cons function (lambda Y1136 (function Y1136)))) (do (shen.set-lambda-form-entry (cons gensym (lambda Y1135 (gensym Y1135)))) (do (shen.set-lambda-form-entry (cons get (lambda Y1132 (lambda Y1133 (lambda Y1134 (get Y1132 Y1133 Y1134)))))) (do (shen.set-lambda-form-entry (cons <-vector (lambda Y1124 (lambda Y1125 (<-vector Y1124 Y1125))))) (do (shen.set-lambda-form-entry (cons > (lambda Y1122 (lambda Y1123 (> Y1122 Y1123))))) (do (shen.set-lambda-form-entry (cons >= (lambda Y1120 (lambda Y1121 (>= Y1120 Y1121))))) (do (shen.set-lambda-form-entry (cons = (lambda Y1118 (lambda Y1119 (= Y1118 Y1119))))) (do (shen.set-lambda-form-entry (cons hash (lambda Y1116 (lambda Y1117 (hash Y1116 Y1117))))) (do (shen.set-lambda-form-entry (cons hd (lambda Y1115 (hd Y1115)))) (do (shen.set-lambda-form-entry (cons hdv (lambda Y1114 (hdv Y1114)))) (do (shen.set-lambda-form-entry (cons hdstr (lambda Y1113 (hdstr Y1113)))) (do (shen.set-lambda-form-entry (cons head (lambda Y1112 (head Y1112)))) (do (shen.set-lambda-form-entry (cons if (lambda Y1108 (lambda Y1109 (lambda Y1110 (if Y1108 Y1109 Y1110)))))) (do (shen.set-lambda-form-entry (cons integer? (lambda Y1105 (integer? Y1105)))) (do (shen.set-lambda-form-entry (cons intern (lambda Y1103 (intern Y1103)))) (do (shen.set-lambda-form-entry (cons input (lambda Y1102 (input Y1102)))) (do (shen.set-lambda-form-entry (cons input+ (lambda Y1100 (lambda Y1101 (input+ Y1100 Y1101))))) (do (shen.set-lambda-form-entry (cons is (lambda Y1090 (lambda Y1091 (lambda Y1092 (lambda Y1093 (lambda Y1094 (lambda Y1095 (is Y1090 Y1091 Y1092 Y1093 Y1094 Y1095))))))))) (do (shen.set-lambda-form-entry (cons is! (lambda Y1084 (lambda Y1085 (lambda Y1086 (lambda Y1087 (lambda Y1088 (lambda Y1089 (is! Y1084 Y1085 Y1086 Y1087 Y1088 Y1089))))))))) (do (shen.set-lambda-form-entry (cons length (lambda Y1083 (length Y1083)))) (do (shen.set-lambda-form-entry (cons limit (lambda Y1082 (limit Y1082)))) (do (shen.set-lambda-form-entry (cons lineread (lambda Y1081 (lineread Y1081)))) (do (shen.set-lambda-form-entry (cons load (lambda Y1080 (load Y1080)))) (do (shen.set-lambda-form-entry (cons < (lambda Y1078 (lambda Y1079 (< Y1078 Y1079))))) (do (shen.set-lambda-form-entry (cons <= (lambda Y1076 (lambda Y1077 (<= Y1076 Y1077))))) (do (shen.set-lambda-form-entry (cons vector (lambda Y1075 (vector Y1075)))) (do (shen.set-lambda-form-entry (cons macroexpand (lambda Y1074 (macroexpand Y1074)))) (do (shen.set-lambda-form-entry (cons map (lambda Y1072 (lambda Y1073 (map Y1072 Y1073))))) (do (shen.set-lambda-form-entry (cons mapcan (lambda Y1070 (lambda Y1071 (mapcan Y1070 Y1071))))) (do (shen.set-lambda-form-entry (cons nl (lambda Y1068 (nl Y1068)))) (do (shen.set-lambda-form-entry (cons not (lambda Y1067 (not Y1067)))) (do (shen.set-lambda-form-entry (cons number? (lambda Y1063 (number? Y1063)))) (do (shen.set-lambda-form-entry (cons occurrences (lambda Y1060 (lambda Y1061 (occurrences Y1060 Y1061))))) (do (shen.set-lambda-form-entry (cons or (lambda Y1054 (lambda Y1055 (or Y1054 Y1055))))) (do (shen.set-lambda-form-entry (cons pos (lambda Y1051 (lambda Y1052 (pos Y1051 Y1052))))) (do (shen.set-lambda-form-entry (cons print (lambda Y1049 (print Y1049)))) (do (shen.set-lambda-form-entry (cons shen.print-prolog-vector (lambda Y1047 (shen.print-prolog-vector Y1047)))) (do (shen.set-lambda-form-entry (cons shen.print-freshterm (lambda Y1046 (shen.print-freshterm Y1046)))) (do (shen.set-lambda-form-entry (cons shen.printF (lambda Y1045 (shen.printF Y1045)))) (do (shen.set-lambda-form-entry (cons prolog-memory (lambda Y1044 (prolog-memory Y1044)))) (do (shen.set-lambda-form-entry (cons pr (lambda Y1041 (lambda Y1042 (pr Y1041 Y1042))))) (do (shen.set-lambda-form-entry (cons ps (lambda Y1040 (ps Y1040)))) (do (shen.set-lambda-form-entry (cons protect (lambda Y1037 (protect Y1037)))) (do (shen.set-lambda-form-entry (cons put (lambda Y1033 (lambda Y1034 (lambda Y1035 (lambda Y1036 (put Y1033 Y1034 Y1035 Y1036))))))) (do (shen.set-lambda-form-entry (cons read-file-as-bytelist (lambda Y1031 (read-file-as-bytelist Y1031)))) (do (shen.set-lambda-form-entry (cons read-file (lambda Y1030 (read-file Y1030)))) (do (shen.set-lambda-form-entry (cons read (lambda Y1029 (read Y1029)))) (do (shen.set-lambda-form-entry (cons remove (lambda Y1023 (lambda Y1024 (remove Y1023 Y1024))))) (do (shen.set-lambda-form-entry (cons reverse (lambda Y1022 (reverse Y1022)))) (do (shen.set-lambda-form-entry (cons set (lambda Y1020 (lambda Y1021 (set Y1020 Y1021))))) (do (shen.set-lambda-form-entry (cons simple-error (lambda Y1019 (simple-error Y1019)))) (do (shen.set-lambda-form-entry (cons snd (lambda Y1018 (snd Y1018)))) (do (shen.set-lambda-form-entry (cons str (lambda Y1013 (str Y1013)))) (do (shen.set-lambda-form-entry (cons string->n (lambda Y1012 (string->n Y1012)))) (do (shen.set-lambda-form-entry (cons subst (lambda Y1007 (lambda Y1008 (lambda Y1009 (subst Y1007 Y1008 Y1009)))))) (do (shen.set-lambda-form-entry (cons symbol? (lambda Y1005 (symbol? Y1005)))) (do (shen.set-lambda-form-entry (cons tail (lambda Y1003 (tail Y1003)))) (do (shen.set-lambda-form-entry (cons tl (lambda Y1002 (tl Y1002)))) (do (shen.set-lambda-form-entry (cons thaw (lambda Y1000 (thaw Y1000)))) (do (shen.set-lambda-form-entry (cons tlstr (lambda Y999 (tlstr Y999)))) (do (shen.set-lambda-form-entry (cons trap-error (lambda Y996 (lambda Y997 (trap-error Y996 Y997))))) (do (shen.set-lambda-form-entry (cons tuple? (lambda Y995 (tuple? Y995)))) (do (shen.set-lambda-form-entry (cons return (lambda Y988 (lambda Y989 (lambda Y990 (lambda Y991 (lambda Y992 (return Y988 Y989 Y990 Y991 Y992)))))))) (do (shen.set-lambda-form-entry (cons unput (lambda Y983 (lambda Y984 (lambda Y985 (unput Y983 Y984 Y985)))))) (do (shen.set-lambda-form-entry (cons union (lambda Y980 (lambda Y981 (union Y980 Y981))))) (do (shen.set-lambda-form-entry (cons vector (lambda Y975 (vector Y975)))) (do (shen.set-lambda-form-entry (cons vector? (lambda Y974 (vector? Y974)))) (do (shen.set-lambda-form-entry (cons vector-> (lambda Y971 (lambda Y972 (lambda Y973 (vector-> Y971 Y972 Y973)))))) (do (shen.set-lambda-form-entry (cons value (lambda Y970 (value Y970)))) (do (shen.set-lambda-form-entry (cons variable? (lambda Y969 (variable? Y969)))) (do (shen.set-lambda-form-entry (cons when (lambda Y959 (lambda Y960 (lambda Y961 (lambda Y962 (lambda Y963 (when Y959 Y960 Y961 Y962 Y963)))))))) (do (shen.set-lambda-form-entry (cons y-or-n? (lambda Y954 (y-or-n? Y954)))) (do (shen.set-lambda-form-entry (cons + (lambda Y952 (lambda Y953 (+ Y952 Y953))))) (do (shen.set-lambda-form-entry (cons * (lambda Y950 (lambda Y951 (* Y950 Y951))))) (do (shen.set-lambda-form-entry (cons / (lambda Y948 (lambda Y949 (/ Y948 Y949))))) (do (shen.set-lambda-form-entry (cons - (lambda Y946 (lambda Y947 (- Y946 Y947))))) (do (shen.set-lambda-form-entry (cons (lambda Y943 ( Y943)))) (do (shen.set-lambda-form-entry (cons (lambda Y942 ( Y942)))) (do (shen.set-lambda-form-entry (cons (lambda Y941 ( Y941)))) (do (shen.set-lambda-form-entry (cons @p (lambda Y939 (lambda Y940 (@p Y939 Y940))))) (do (shen.set-lambda-form-entry (cons @v (lambda Y937 (lambda Y938 (@v Y937 Y938))))) (shen.set-lambda-form-entry (cons @s (lambda Y935 (lambda Y936 (@s Y935 Y936))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) - -(defun shen.initialise () (do (shen.initialise-environment) (do (shen.initialise-lambda-forms) (shen.initialise-signedfuncs)))) - -(defun max (V310 V311) (cond ((> V311 V310) V311) (true V310))) - -(defun gcd (V336 V337) (if (and (integer? V336) (integer? V337)) (let W338 (abs V336) (let W339 (abs V337) (if (> W338 W339) (maths.gcd-help (- W338 W339) W339) (maths.gcd-help W338 (- W339 W338))))) (simple-error "gcd expects integer inputs"))) - -(defun maths.gcd-help (V342 V343) (if (> V342 V343) (maths.gcd-loop V342 V343 V343) (maths.gcd-loop V342 V343 V342))) - -(defun maths.gcd-loop (V350 V351 V352) (cond ((= 1 V352) 1) ((and (integer? (/ V350 V352)) (integer? (/ V351 V352))) V352) (true (maths.gcd-loop V350 V351 (- V352 1))))) - -(defun abs (V505) (if (>= V505 0) V505 (- 0 V505))) - -(defun filter (V1414 V1415) (cond ((= () V1415) ()) ((cons? V1415) (if (V1414 (hd V1415)) (cons (hd V1415) (filter V1414 (tl V1415))) (filter V1414 (tl V1415)))) (true (shen.f-error filter)))) - -(defun digit? (V1799) (cond ((shen.+string? V1799) (let W1800 (string->n (hdstr V1799)) (and (> W1800 47) (< W1800 58)))) (true (shen.f-error digit?)))) - diff --git a/crates/shenffi/include/shenffi.h b/crates/shenffi/include/shenffi.h index 051ab02..40b13ca 100644 --- a/crates/shenffi/include/shenffi.h +++ b/crates/shenffi/include/shenffi.h @@ -28,16 +28,7 @@ char *shen_eval(ShenCtx *ctx, const char *src); * shen_free(). */ ShenCtx *shen_boot_shaken(const char *kernel_kl, const char *prog_kl); -/* --- shen-cas: embedded, tree-shaken computer algebra system --- */ - -/* Boot the embedded shen-cas slice. Free with shen_free(). */ -ShenCtx *shen_cas_boot(void); - -/* Parse + reduce + pretty-print a CAS expression, e.g. "D[Sin[x],x]" -> "[Cos x]". - * Returns a heap string; release with shen_string_free(). */ -char *shen_cas_reduce(ShenCtx *ctx, const char *src); - -/* Free a string returned by shen_eval() / shen_cas_reduce(). */ +/* Free a string returned by shen_eval(). */ void shen_string_free(char *s); /* Free a handle returned by shen_boot(). */ diff --git a/crates/shenffi/src/lib.rs b/crates/shenffi/src/lib.rs index f529015..3b6f503 100644 --- a/crates/shenffi/src/lib.rs +++ b/crates/shenffi/src/lib.rs @@ -92,16 +92,6 @@ pub extern "C" fn shen_boot_embedded() -> *mut ShenCtx { } } -// --- shen-cas: a tree-shaken computer-algebra system embedded in the binary --- -// -// Produced by `ratatoskr shake` over the flattened shen-cas sources: a minimal -// kernel slice (only what the CAS reaches) plus the CAS compiled to KLambda. -// Demonstrates the full pipeline: Shen program -> ratatoskr tree-shake -> Rust -// static lib -> Swift. No Shen-level `eval` needed; we call the CAS's own -// functions (`parse-expr-string` -> `reduce` -> `pretty-expr`) directly. -const CAS_KERNEL: &str = include_str!("../cas/cas-kernel.kl"); -const CAS_PROG: &str = include_str!("../cas/cas-all.kl"); - /// Boots any Ratatoskr-shaken program: a shaken `kernel.kl` slice plus an /// optional program `.kl`. Pass NULL `prog_kl` for kernel-only. /// @@ -157,119 +147,6 @@ fn boot_shaken_inner(kernel: &str, prog: Option<&str>) -> Result Ok(interp) } -/// Boots the embedded shen-cas slice (shaken kernel + CAS), tree-walked. -#[no_mangle] -pub extern "C" fn shen_cas_boot() -> *mut ShenCtx { - match boot_shaken_inner(CAS_KERNEL, Some(CAS_PROG)) { - Ok(interp) => Box::into_raw(Box::new(ShenCtx { interp })), - Err(e) => { - eprintln!("shen_cas_boot error: {e}"); - std::ptr::null_mut() - } - } -} - -/// Parses, reduces, and pretty-prints one CAS expression (e.g. "D[Sin[x],x]"). -/// Returns the normal form rendered as a string ("error: …" on failure). -/// -/// # Safety -/// `ctx` must be a `shen_cas_boot` handle and `src` a valid C string. -#[no_mangle] -pub extern "C" fn shen_cas_reduce(ctx: *mut ShenCtx, src: *const c_char) -> *mut c_char { - if ctx.is_null() || src.is_null() { - return std::ptr::null_mut(); - } - let ctx = unsafe { &mut *ctx }; - let input = unsafe { CStr::from_ptr(src) } - .to_string_lossy() - .into_owned(); - let out = match cas_reduce(&mut ctx.interp, &input) { - Ok(s) => s, - Err(e) => format!("error: {e}"), - }; - CString::new(out) - .unwrap_or_else(|_| CString::new("").unwrap()) - .into_raw() -} - -fn cas_reduce(interp: &mut Interp, input: &str) -> Result { - let parse_sym = interp.intern("parse-expr-string"); - let reduce_sym = interp.intern("reduce"); - let pretty_sym = interp.intern("pretty-expr"); - let app_sym = interp.intern("shen.app"); - let mode = Value::sym(interp.intern("shen.s")); - - let parse_fn = interp - .env - .get_fn(parse_sym) - .cloned() - .ok_or_else(|| "parse-expr-string is undefined".to_string())?; - let ast = interp - .apply(parse_fn, vec![Value::str(input)]) - .map_err(|e| e.to_string())?; - - let reduce_fn = interp - .env - .get_fn(reduce_sym) - .cloned() - .ok_or_else(|| "reduce is undefined".to_string())?; - let nf = interp - .apply(reduce_fn, vec![ast]) - .map_err(|e| e.to_string())?; - - let pretty_fn = interp - .env - .get_fn(pretty_sym) - .cloned() - .ok_or_else(|| "pretty-expr is undefined".to_string())?; - let pretty = interp - .apply(pretty_fn, vec![nf]) - .map_err(|e| e.to_string())?; - - let app_fn = interp - .env - .get_fn(app_sym) - .cloned() - .ok_or_else(|| "shen.app is undefined".to_string())?; - let rendered = interp - .apply(app_fn, vec![pretty, Value::str(""), mode]) - .map_err(|e| e.to_string())?; - - rendered - .as_str() - .map(|s| s.to_string()) - .ok_or_else(|| "CAS result did not render to a string".to_string()) -} - -/// Safe Rust API over the embedded shen-cas — for Rust hosts (e.g. the iced -/// desktop app) that link this crate as an `rlib` and don't want the C ABI's -/// raw pointers. Mirrors `shen_cas_boot` / `shen_cas_reduce`. -/// -/// Note: the CAS reducer is deeply recursive and tree-walked, so both `boot` -/// and `reduce` should run on a thread with a large stack (~16 MB minimum; the -/// default 8 MB overflows on boot). See the iced app's worker thread, or -/// `ShenCAS.swift` on the Swift side, for the pattern. -pub struct CasEngine { - interp: Interp, -} - -impl CasEngine { - /// Boots the embedded shen-cas slice (shaken kernel + CAS program). - pub fn boot() -> Result { - boot_shaken_inner(CAS_KERNEL, Some(CAS_PROG)).map(|interp| CasEngine { interp }) - } - - /// Reduces one CAS expression (e.g. `"D[Sin[x],x]"`) to its rendered normal - /// form. Returns `"error: "` on failure rather than erroring, so - /// callers can display the string directly. - pub fn reduce(&mut self, input: &str) -> String { - match cas_reduce(&mut self.interp, input) { - Ok(s) => s, - Err(e) => format!("error: {e}"), - } - } -} - /// Evaluates a Shen expression and returns its rendered value as a freshly /// allocated C string (release with `shen_string_free`). On error the string is /// `"error: "`. Returns NULL only if the arguments are NULL. diff --git a/crates/shenffi/swift/cas-demo.swift b/crates/shenffi/swift/cas-demo.swift deleted file mode 100644 index 7efbf5b..0000000 --- a/crates/shenffi/swift/cas-demo.swift +++ /dev/null @@ -1,34 +0,0 @@ -import Foundation - -// Swift -> Rust -> (tree-shaken) shen-cas computer algebra system. -// -// The CAS reducer is deeply recursive and runs tree-walked, so drive it on a -// thread with a large stack (the shen-rust CLI does the same). In an app, call -// the FFI from a dedicated big-stack background thread. - -final class CASRunner: Thread { - override func main() { - guard let ctx = shen_cas_boot() else { - FileHandle.standardError.write(Data("cas boot failed\n".utf8)) - Foundation.exit(1) - } - defer { shen_free(ctx) } - - func cas(_ s: String) -> String { - guard let out = s.withCString({ shen_cas_reduce(ctx, $0) }) else { return "" } - defer { shen_string_free(out) } - return String(cString: out) - } - - print("--- shen-cas (embedded in Rust, called from Swift) ---") - for expr in ["2 + 3", "6/4", "a+b*c", "Sin[x]", "D[Sin[x],x]", "D[x^3,x]", "D[Exp[x],x]"] { - print("\(expr) => \(cas(expr))") - } - Foundation.exit(0) - } -} - -let runner = CASRunner() -runner.stackSize = 512 * 1024 * 1024 -runner.start() -while !runner.isFinished { Thread.sleep(forTimeInterval: 0.02) }