From c91b6092bc37140a792fd06800438b46b18ddb3b Mon Sep 17 00:00:00 2001 From: Yogthos Date: Tue, 23 Jun 2026 09:54:32 -0400 Subject: [PATCH 1/3] =?UTF-8?q?ffi:=20foreign-callable=20=E2=80=94=20recei?= =?UTF-8?q?ve=20callbacks=20from=20C?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit jolt could call C (foreign-fn -> foreign-procedure) but C could not call back into jolt, which GTK signals (and any callback-taking C API) require. Add the inverse: jolt.ffi/foreign-callable wraps a jolt fn as a C-callable function pointer, mirroring the foreign-fn pipeline. A new jolt.ffi/__ccallable special form carries the fn as a child expression (analyzed + walked by the passes; ir.clj gains an :ffi-callable arm in both child walks) plus literal arg/ret type keywords. The back end lowers it to a locked Chez foreign-callable and returns its entry-point address as a jolt pointer; host/chez/ffi.ss registers the code object so the collector keeps it, and free-callable unlocks it. :collect-safe emits the convention that reactivates the thread on entry, for callbacks fired while it is parked in a :blocking call (a GTK main loop). Test: ffi-binding-test.ss sorts an int array through libc qsort with a jolt comparator (C -> jolt -> C). Re-minted seed. --- host/chez/ffi.ss | 19 ++++ host/chez/seed/image.ss | 142 +++++++++++++++--------------- jolt-core/jolt/analyzer.clj | 27 ++++++ jolt-core/jolt/backend_scheme.clj | 14 +++ jolt-core/jolt/ir.clj | 2 + stdlib/jolt/ffi.clj | 20 ++++- test/chez/ffi-binding-test.ss | 24 +++++ 7 files changed, 178 insertions(+), 70 deletions(-) diff --git a/host/chez/ffi.ss b/host/chez/ffi.ss index 2c1f98c..c595b40 100644 --- a/host/chez/ffi.ss +++ b/host/chez/ffi.ss @@ -116,7 +116,26 @@ (foreign-set! 'unsigned-8 p n 0) p)) +;; --- callbacks: receive calls FROM C ---------------------------------------- +;; jolt.ffi/foreign-callable lowers to (jolt-ffi-register-callable! (foreign-callable …)). +;; A foreign-callable code object must be LOCKED (so the collector neither moves +;; nor reclaims it) and RETAINED while C may still call through its entry point. +;; Register it keyed by that entry-point address (a jolt pointer integer) — which +;; is what the caller hands to C; free-callable unlocks and drops it. A callback +;; left registered lives for the process (the GTK-signal-handler common case). +(define ffi-callable-table (make-eqv-hashtable)) ; entry-point addr -> code object +(define (jolt-ffi-register-callable! co) + (lock-object co) + (let ((addr (foreign-callable-entry-point co))) + (hashtable-set! ffi-callable-table addr co) + addr)) +(define (ffi-free-callable addr) + (let* ((a (jnum->exact addr)) (co (hashtable-ref ffi-callable-table a #f))) + (when co (unlock-object co) (hashtable-delete! ffi-callable-table a)) + jolt-nil)) + ;; --- expose under jolt.ffi --------------------------------------------------- +(def-var! "jolt.ffi" "free-callable" ffi-free-callable) (def-var! "jolt.ffi" "load-library" ffi-load-library) (def-var! "jolt.ffi" "loaded?" (lambda (n) (if (ffi-loaded? n) #t #f))) (def-var! "jolt.ffi" "alloc" ffi-alloc) diff --git a/host/chez/seed/image.ss b/host/chez/seed/image.ss index 5b28d2b..54b8ec6 100644 --- a/host/chez/seed/image.ss +++ b/host/chez/seed/image.ss @@ -1,113 +1,115 @@ (guard (e (#t #f)) - (def-var! "jolt.ir" "const" (letrec ((const (lambda (v) (let fnrec4412 ((v v)) (let* ((_o$4413 (keyword #f "op")) (_o$4414 (keyword #f "const")) (_o$4415 (keyword #f "val")) (_o$4416 v)) (jolt-hash-map _o$4413 _o$4414 _o$4415 _o$4416)))))) const))) + (def-var! "jolt.ir" "const" (letrec ((const (lambda (v) (let fnrec4422 ((v v)) (let* ((_o$4423 (keyword #f "op")) (_o$4424 (keyword #f "const")) (_o$4425 (keyword #f "val")) (_o$4426 v)) (jolt-hash-map _o$4423 _o$4424 _o$4425 _o$4426)))))) const))) (guard (e (#t #f)) - (def-var! "jolt.ir" "local" (letrec ((local (lambda (name) (let fnrec4417 ((name name)) (let* ((_o$4418 (keyword #f "op")) (_o$4419 (keyword #f "local")) (_o$4420 (keyword #f "name")) (_o$4421 name)) (jolt-hash-map _o$4418 _o$4419 _o$4420 _o$4421)))))) local))) + (def-var! "jolt.ir" "local" (letrec ((local (lambda (name) (let fnrec4427 ((name name)) (let* ((_o$4428 (keyword #f "op")) (_o$4429 (keyword #f "local")) (_o$4430 (keyword #f "name")) (_o$4431 name)) (jolt-hash-map _o$4428 _o$4429 _o$4430 _o$4431)))))) local))) (guard (e (#t #f)) - (def-var! "jolt.ir" "var-ref" (letrec ((var-ref (lambda (ns name) (let fnrec4422 ((ns ns) (name name)) (let* ((_o$4423 (keyword #f "op")) (_o$4424 (keyword #f "var")) (_o$4425 (keyword #f "ns")) (_o$4426 ns) (_o$4427 (keyword #f "name")) (_o$4428 name)) (jolt-hash-map _o$4423 _o$4424 _o$4425 _o$4426 _o$4427 _o$4428)))))) var-ref))) + (def-var! "jolt.ir" "var-ref" (letrec ((var-ref (lambda (ns name) (let fnrec4432 ((ns ns) (name name)) (let* ((_o$4433 (keyword #f "op")) (_o$4434 (keyword #f "var")) (_o$4435 (keyword #f "ns")) (_o$4436 ns) (_o$4437 (keyword #f "name")) (_o$4438 name)) (jolt-hash-map _o$4433 _o$4434 _o$4435 _o$4436 _o$4437 _o$4438)))))) var-ref))) (guard (e (#t #f)) - (def-var! "jolt.ir" "the-var" (letrec ((the-var (lambda (ns name) (let fnrec4429 ((ns ns) (name name)) (let* ((_o$4430 (keyword #f "op")) (_o$4431 (keyword #f "the-var")) (_o$4432 (keyword #f "ns")) (_o$4433 ns) (_o$4434 (keyword #f "name")) (_o$4435 name)) (jolt-hash-map _o$4430 _o$4431 _o$4432 _o$4433 _o$4434 _o$4435)))))) the-var))) + (def-var! "jolt.ir" "the-var" (letrec ((the-var (lambda (ns name) (let fnrec4439 ((ns ns) (name name)) (let* ((_o$4440 (keyword #f "op")) (_o$4441 (keyword #f "the-var")) (_o$4442 (keyword #f "ns")) (_o$4443 ns) (_o$4444 (keyword #f "name")) (_o$4445 name)) (jolt-hash-map _o$4440 _o$4441 _o$4442 _o$4443 _o$4444 _o$4445)))))) the-var))) (guard (e (#t #f)) - (def-var! "jolt.ir" "host-ref" (letrec ((host-ref (lambda (name) (let fnrec4436 ((name name)) (let* ((_o$4437 (keyword #f "op")) (_o$4438 (keyword #f "host")) (_o$4439 (keyword #f "name")) (_o$4440 name)) (jolt-hash-map _o$4437 _o$4438 _o$4439 _o$4440)))))) host-ref))) + (def-var! "jolt.ir" "host-ref" (letrec ((host-ref (lambda (name) (let fnrec4446 ((name name)) (let* ((_o$4447 (keyword #f "op")) (_o$4448 (keyword #f "host")) (_o$4449 (keyword #f "name")) (_o$4450 name)) (jolt-hash-map _o$4447 _o$4448 _o$4449 _o$4450)))))) host-ref))) (guard (e (#t #f)) - (def-var! "jolt.ir" "host-static" (letrec ((host-static (lambda (class member) (let fnrec4441 ((class class) (member member)) (let* ((_o$4442 (keyword #f "op")) (_o$4443 (keyword #f "host-static")) (_o$4444 (keyword #f "class")) (_o$4445 class) (_o$4446 (keyword #f "member")) (_o$4447 member)) (jolt-hash-map _o$4442 _o$4443 _o$4444 _o$4445 _o$4446 _o$4447)))))) host-static))) + (def-var! "jolt.ir" "host-static" (letrec ((host-static (lambda (class member) (let fnrec4451 ((class class) (member member)) (let* ((_o$4452 (keyword #f "op")) (_o$4453 (keyword #f "host-static")) (_o$4454 (keyword #f "class")) (_o$4455 class) (_o$4456 (keyword #f "member")) (_o$4457 member)) (jolt-hash-map _o$4452 _o$4453 _o$4454 _o$4455 _o$4456 _o$4457)))))) host-static))) (guard (e (#t #f)) - (def-var! "jolt.ir" "host-new" (letrec ((host-new (lambda (class args) (let fnrec4448 ((class class) (args args)) (let* ((_o$4449 (keyword #f "op")) (_o$4450 (keyword #f "host-new")) (_o$4451 (keyword #f "class")) (_o$4452 class) (_o$4453 (keyword #f "args")) (_o$4454 args)) (jolt-hash-map _o$4449 _o$4450 _o$4451 _o$4452 _o$4453 _o$4454)))))) host-new))) + (def-var! "jolt.ir" "host-new" (letrec ((host-new (lambda (class args) (let fnrec4458 ((class class) (args args)) (let* ((_o$4459 (keyword #f "op")) (_o$4460 (keyword #f "host-new")) (_o$4461 (keyword #f "class")) (_o$4462 class) (_o$4463 (keyword #f "args")) (_o$4464 args)) (jolt-hash-map _o$4459 _o$4460 _o$4461 _o$4462 _o$4463 _o$4464)))))) host-new))) (guard (e (#t #f)) - (def-var! "jolt.ir" "if-node" (letrec ((if-node (lambda (test then _else) (let fnrec4455 ((test test) (then then) (_else _else)) (let* ((_o$4456 (keyword #f "op")) (_o$4457 (keyword #f "if")) (_o$4458 (keyword #f "test")) (_o$4459 test) (_o$4460 (keyword #f "then")) (_o$4461 then) (_o$4462 (keyword #f "else")) (_o$4463 _else)) (jolt-hash-map _o$4456 _o$4457 _o$4458 _o$4459 _o$4460 _o$4461 _o$4462 _o$4463)))))) if-node))) + (def-var! "jolt.ir" "if-node" (letrec ((if-node (lambda (test then _else) (let fnrec4465 ((test test) (then then) (_else _else)) (let* ((_o$4466 (keyword #f "op")) (_o$4467 (keyword #f "if")) (_o$4468 (keyword #f "test")) (_o$4469 test) (_o$4470 (keyword #f "then")) (_o$4471 then) (_o$4472 (keyword #f "else")) (_o$4473 _else)) (jolt-hash-map _o$4466 _o$4467 _o$4468 _o$4469 _o$4470 _o$4471 _o$4472 _o$4473)))))) if-node))) (guard (e (#t #f)) - (def-var! "jolt.ir" "do-node" (letrec ((do-node (lambda (statements ret) (let fnrec4464 ((statements statements) (ret ret)) (let* ((_o$4465 (keyword #f "op")) (_o$4466 (keyword #f "do")) (_o$4467 (keyword #f "statements")) (_o$4468 statements) (_o$4469 (keyword #f "ret")) (_o$4470 ret)) (jolt-hash-map _o$4465 _o$4466 _o$4467 _o$4468 _o$4469 _o$4470)))))) do-node))) + (def-var! "jolt.ir" "do-node" (letrec ((do-node (lambda (statements ret) (let fnrec4474 ((statements statements) (ret ret)) (let* ((_o$4475 (keyword #f "op")) (_o$4476 (keyword #f "do")) (_o$4477 (keyword #f "statements")) (_o$4478 statements) (_o$4479 (keyword #f "ret")) (_o$4480 ret)) (jolt-hash-map _o$4475 _o$4476 _o$4477 _o$4478 _o$4479 _o$4480)))))) do-node))) (guard (e (#t #f)) - (def-var! "jolt.ir" "invoke" (letrec ((invoke (lambda (f args) (let fnrec4471 ((f f) (args args)) (let* ((_o$4472 (keyword #f "op")) (_o$4473 (keyword #f "invoke")) (_o$4474 (keyword #f "fn")) (_o$4475 f) (_o$4476 (keyword #f "args")) (_o$4477 args)) (jolt-hash-map _o$4472 _o$4473 _o$4474 _o$4475 _o$4476 _o$4477)))))) invoke))) + (def-var! "jolt.ir" "invoke" (letrec ((invoke (lambda (f args) (let fnrec4481 ((f f) (args args)) (let* ((_o$4482 (keyword #f "op")) (_o$4483 (keyword #f "invoke")) (_o$4484 (keyword #f "fn")) (_o$4485 f) (_o$4486 (keyword #f "args")) (_o$4487 args)) (jolt-hash-map _o$4482 _o$4483 _o$4484 _o$4485 _o$4486 _o$4487)))))) invoke))) (guard (e (#t #f)) - (def-var! "jolt.ir" "def-node" (letrec ((def-node (case-lambda ((ns name init) (let fnrec4478 ((ns ns) (name name) (init init)) (let* ((_o$4479 (keyword #f "op")) (_o$4480 (keyword #f "def")) (_o$4481 (keyword #f "ns")) (_o$4482 ns) (_o$4483 (keyword #f "name")) (_o$4484 name) (_o$4485 (keyword #f "init")) (_o$4486 init)) (jolt-hash-map _o$4479 _o$4480 _o$4481 _o$4482 _o$4483 _o$4484 _o$4485 _o$4486)))) ((ns name init meta) (let fnrec4487 ((ns ns) (name name) (init init) (meta meta)) (if (jolt-truthy? meta) (let* ((_o$4488 (keyword #f "op")) (_o$4489 (keyword #f "def")) (_o$4490 (keyword #f "ns")) (_o$4491 ns) (_o$4492 (keyword #f "name")) (_o$4493 name) (_o$4494 (keyword #f "init")) (_o$4495 init) (_o$4496 (keyword #f "meta")) (_o$4497 meta)) (jolt-hash-map _o$4488 _o$4489 _o$4490 _o$4491 _o$4492 _o$4493 _o$4494 _o$4495 _o$4496 _o$4497)) (let* ((_o$4498 (keyword #f "op")) (_o$4499 (keyword #f "def")) (_o$4500 (keyword #f "ns")) (_o$4501 ns) (_o$4502 (keyword #f "name")) (_o$4503 name) (_o$4504 (keyword #f "init")) (_o$4505 init)) (jolt-hash-map _o$4498 _o$4499 _o$4500 _o$4501 _o$4502 _o$4503 _o$4504 _o$4505)))))))) def-node))) + (def-var! "jolt.ir" "def-node" (letrec ((def-node (case-lambda ((ns name init) (let fnrec4488 ((ns ns) (name name) (init init)) (let* ((_o$4489 (keyword #f "op")) (_o$4490 (keyword #f "def")) (_o$4491 (keyword #f "ns")) (_o$4492 ns) (_o$4493 (keyword #f "name")) (_o$4494 name) (_o$4495 (keyword #f "init")) (_o$4496 init)) (jolt-hash-map _o$4489 _o$4490 _o$4491 _o$4492 _o$4493 _o$4494 _o$4495 _o$4496)))) ((ns name init meta) (let fnrec4497 ((ns ns) (name name) (init init) (meta meta)) (if (jolt-truthy? meta) (let* ((_o$4498 (keyword #f "op")) (_o$4499 (keyword #f "def")) (_o$4500 (keyword #f "ns")) (_o$4501 ns) (_o$4502 (keyword #f "name")) (_o$4503 name) (_o$4504 (keyword #f "init")) (_o$4505 init) (_o$4506 (keyword #f "meta")) (_o$4507 meta)) (jolt-hash-map _o$4498 _o$4499 _o$4500 _o$4501 _o$4502 _o$4503 _o$4504 _o$4505 _o$4506 _o$4507)) (let* ((_o$4508 (keyword #f "op")) (_o$4509 (keyword #f "def")) (_o$4510 (keyword #f "ns")) (_o$4511 ns) (_o$4512 (keyword #f "name")) (_o$4513 name) (_o$4514 (keyword #f "init")) (_o$4515 init)) (jolt-hash-map _o$4508 _o$4509 _o$4510 _o$4511 _o$4512 _o$4513 _o$4514 _o$4515)))))))) def-node))) (guard (e (#t #f)) - (def-var! "jolt.ir" "let-node" (letrec ((let-node (lambda (bindings body) (let fnrec4506 ((bindings bindings) (body body)) (let* ((_o$4507 (keyword #f "op")) (_o$4508 (keyword #f "let")) (_o$4509 (keyword #f "bindings")) (_o$4510 bindings) (_o$4511 (keyword #f "body")) (_o$4512 body)) (jolt-hash-map _o$4507 _o$4508 _o$4509 _o$4510 _o$4511 _o$4512)))))) let-node))) + (def-var! "jolt.ir" "let-node" (letrec ((let-node (lambda (bindings body) (let fnrec4516 ((bindings bindings) (body body)) (let* ((_o$4517 (keyword #f "op")) (_o$4518 (keyword #f "let")) (_o$4519 (keyword #f "bindings")) (_o$4520 bindings) (_o$4521 (keyword #f "body")) (_o$4522 body)) (jolt-hash-map _o$4517 _o$4518 _o$4519 _o$4520 _o$4521 _o$4522)))))) let-node))) (guard (e (#t #f)) - (def-var! "jolt.ir" "fn-node" (letrec ((fn-node (lambda (name arities) (let fnrec4513 ((name name) (arities arities)) (if (jolt-truthy? name) (let* ((_o$4514 (keyword #f "op")) (_o$4515 (keyword #f "fn")) (_o$4516 (keyword #f "name")) (_o$4517 name) (_o$4518 (keyword #f "arities")) (_o$4519 arities)) (jolt-hash-map _o$4514 _o$4515 _o$4516 _o$4517 _o$4518 _o$4519)) (let* ((_o$4520 (keyword #f "op")) (_o$4521 (keyword #f "fn")) (_o$4522 (keyword #f "arities")) (_o$4523 arities)) (jolt-hash-map _o$4520 _o$4521 _o$4522 _o$4523))))))) fn-node))) + (def-var! "jolt.ir" "fn-node" (letrec ((fn-node (lambda (name arities) (let fnrec4523 ((name name) (arities arities)) (if (jolt-truthy? name) (let* ((_o$4524 (keyword #f "op")) (_o$4525 (keyword #f "fn")) (_o$4526 (keyword #f "name")) (_o$4527 name) (_o$4528 (keyword #f "arities")) (_o$4529 arities)) (jolt-hash-map _o$4524 _o$4525 _o$4526 _o$4527 _o$4528 _o$4529)) (let* ((_o$4530 (keyword #f "op")) (_o$4531 (keyword #f "fn")) (_o$4532 (keyword #f "arities")) (_o$4533 arities)) (jolt-hash-map _o$4530 _o$4531 _o$4532 _o$4533))))))) fn-node))) (guard (e (#t #f)) - (def-var! "jolt.ir" "vector-node" (letrec ((vector-node (lambda (items) (let fnrec4524 ((items items)) (let* ((_o$4525 (keyword #f "op")) (_o$4526 (keyword #f "vector")) (_o$4527 (keyword #f "items")) (_o$4528 items)) (jolt-hash-map _o$4525 _o$4526 _o$4527 _o$4528)))))) vector-node))) + (def-var! "jolt.ir" "vector-node" (letrec ((vector-node (lambda (items) (let fnrec4534 ((items items)) (let* ((_o$4535 (keyword #f "op")) (_o$4536 (keyword #f "vector")) (_o$4537 (keyword #f "items")) (_o$4538 items)) (jolt-hash-map _o$4535 _o$4536 _o$4537 _o$4538)))))) vector-node))) (guard (e (#t #f)) - (def-var! "jolt.ir" "map-node" (letrec ((map-node (lambda (pairs) (let fnrec4529 ((pairs pairs)) (let* ((_o$4530 (keyword #f "op")) (_o$4531 (keyword #f "map")) (_o$4532 (keyword #f "pairs")) (_o$4533 pairs)) (jolt-hash-map _o$4530 _o$4531 _o$4532 _o$4533)))))) map-node))) + (def-var! "jolt.ir" "map-node" (letrec ((map-node (lambda (pairs) (let fnrec4539 ((pairs pairs)) (let* ((_o$4540 (keyword #f "op")) (_o$4541 (keyword #f "map")) (_o$4542 (keyword #f "pairs")) (_o$4543 pairs)) (jolt-hash-map _o$4540 _o$4541 _o$4542 _o$4543)))))) map-node))) (guard (e (#t #f)) - (def-var! "jolt.ir" "set-node" (letrec ((set-node (lambda (items) (let fnrec4534 ((items items)) (let* ((_o$4535 (keyword #f "op")) (_o$4536 (keyword #f "set")) (_o$4537 (keyword #f "items")) (_o$4538 items)) (jolt-hash-map _o$4535 _o$4536 _o$4537 _o$4538)))))) set-node))) + (def-var! "jolt.ir" "set-node" (letrec ((set-node (lambda (items) (let fnrec4544 ((items items)) (let* ((_o$4545 (keyword #f "op")) (_o$4546 (keyword #f "set")) (_o$4547 (keyword #f "items")) (_o$4548 items)) (jolt-hash-map _o$4545 _o$4546 _o$4547 _o$4548)))))) set-node))) (guard (e (#t #f)) - (def-var! "jolt.ir" "quote-node" (letrec ((quote-node (lambda (form) (let fnrec4539 ((form form)) (let* ((_o$4540 (keyword #f "op")) (_o$4541 (keyword #f "quote")) (_o$4542 (keyword #f "form")) (_o$4543 form)) (jolt-hash-map _o$4540 _o$4541 _o$4542 _o$4543)))))) quote-node))) + (def-var! "jolt.ir" "quote-node" (letrec ((quote-node (lambda (form) (let fnrec4549 ((form form)) (let* ((_o$4550 (keyword #f "op")) (_o$4551 (keyword #f "quote")) (_o$4552 (keyword #f "form")) (_o$4553 form)) (jolt-hash-map _o$4550 _o$4551 _o$4552 _o$4553)))))) quote-node))) (guard (e (#t #f)) - (def-var! "jolt.ir" "throw-node" (letrec ((throw-node (lambda (expr) (let fnrec4544 ((expr expr)) (let* ((_o$4545 (keyword #f "op")) (_o$4546 (keyword #f "throw")) (_o$4547 (keyword #f "expr")) (_o$4548 expr)) (jolt-hash-map _o$4545 _o$4546 _o$4547 _o$4548)))))) throw-node))) + (def-var! "jolt.ir" "throw-node" (letrec ((throw-node (lambda (expr) (let fnrec4554 ((expr expr)) (let* ((_o$4555 (keyword #f "op")) (_o$4556 (keyword #f "throw")) (_o$4557 (keyword #f "expr")) (_o$4558 expr)) (jolt-hash-map _o$4555 _o$4556 _o$4557 _o$4558)))))) throw-node))) (guard (e (#t #f)) - (def-var! "jolt.ir" "map-ir-children" (letrec ((map-ir-children (lambda (f node) (let fnrec4549 ((f f) (node node)) (let* ((op (jolt-get node (keyword #f "op")))) (if (jolt= op (keyword #f "if")) (let* ((_a$4550 node) (_a$4551 (keyword #f "test")) (_a$4552 (jolt-invoke f (jolt-get node (keyword #f "test")))) (_a$4553 (keyword #f "then")) (_a$4554 (jolt-invoke f (jolt-get node (keyword #f "then")))) (_a$4555 (keyword #f "else")) (_a$4556 (jolt-invoke f (jolt-get node (keyword #f "else"))))) (jolt-assoc _a$4550 _a$4551 _a$4552 _a$4553 _a$4554 _a$4555 _a$4556)) (if (jolt= op (keyword #f "do")) (let* ((_a$4557 node) (_a$4558 (keyword #f "statements")) (_a$4559 (jolt-invoke (var-deref "clojure.core" "mapv") f (jolt-get node (keyword #f "statements")))) (_a$4560 (keyword #f "ret")) (_a$4561 (jolt-invoke f (jolt-get node (keyword #f "ret"))))) (jolt-assoc _a$4557 _a$4558 _a$4559 _a$4560 _a$4561)) (if (jolt= op (keyword #f "throw")) (jolt-assoc node (keyword #f "expr") (jolt-invoke f (jolt-get node (keyword #f "expr")))) (if (jolt= op (keyword #f "set-var")) (jolt-assoc node (keyword #f "val") (jolt-invoke f (jolt-get node (keyword #f "val")))) (if (jolt= op (keyword #f "set-field")) (let* ((_a$4562 node) (_a$4563 (keyword #f "obj")) (_a$4564 (jolt-invoke f (jolt-get node (keyword #f "obj")))) (_a$4565 (keyword #f "val")) (_a$4566 (jolt-invoke f (jolt-get node (keyword #f "val"))))) (jolt-assoc _a$4562 _a$4563 _a$4564 _a$4565 _a$4566)) (if (jolt= op (keyword #f "defmacro")) (jolt-assoc node (keyword #f "fn") (jolt-invoke f (jolt-get node (keyword #f "fn")))) (if (jolt= op (keyword #f "invoke")) (let* ((_a$4567 node) (_a$4568 (keyword #f "fn")) (_a$4569 (jolt-invoke f (jolt-get node (keyword #f "fn")))) (_a$4570 (keyword #f "args")) (_a$4571 (jolt-invoke (var-deref "clojure.core" "mapv") f (jolt-get node (keyword #f "args"))))) (jolt-assoc _a$4567 _a$4568 _a$4569 _a$4570 _a$4571)) (if (jolt= op (keyword #f "vector")) (jolt-assoc node (keyword #f "items") (jolt-invoke (var-deref "clojure.core" "mapv") f (jolt-get node (keyword #f "items")))) (if (jolt= op (keyword #f "set")) (jolt-assoc node (keyword #f "items") (jolt-invoke (var-deref "clojure.core" "mapv") f (jolt-get node (keyword #f "items")))) (if (jolt= op (keyword #f "map")) (jolt-assoc node (keyword #f "pairs") (let* ((_a$4575 (var-deref "clojure.core" "mapv")) (_a$4576 (lambda (pr) (let fnrec4572 ((pr pr)) (let* ((_o$4573 (jolt-invoke f (jolt-nth pr 0))) (_o$4574 (jolt-invoke f (jolt-nth pr 1)))) (jolt-vector _o$4573 _o$4574))))) (_a$4577 (jolt-get node (keyword #f "pairs")))) (jolt-invoke _a$4575 _a$4576 _a$4577))) (if (jolt= op (keyword #f "let")) (let* ((_a$4584 node) (_a$4585 (keyword #f "bindings")) (_a$4586 (let* ((_a$4581 (var-deref "clojure.core" "mapv")) (_a$4582 (lambda (b) (let fnrec4578 ((b b)) (let* ((_o$4579 (jolt-nth b 0)) (_o$4580 (jolt-invoke f (jolt-nth b 1)))) (jolt-vector _o$4579 _o$4580))))) (_a$4583 (jolt-get node (keyword #f "bindings")))) (jolt-invoke _a$4581 _a$4582 _a$4583))) (_a$4587 (keyword #f "body")) (_a$4588 (jolt-invoke f (jolt-get node (keyword #f "body"))))) (jolt-assoc _a$4584 _a$4585 _a$4586 _a$4587 _a$4588)) (if (jolt= op (keyword #f "loop")) (let* ((_a$4595 node) (_a$4596 (keyword #f "bindings")) (_a$4597 (let* ((_a$4592 (var-deref "clojure.core" "mapv")) (_a$4593 (lambda (b) (let fnrec4589 ((b b)) (let* ((_o$4590 (jolt-nth b 0)) (_o$4591 (jolt-invoke f (jolt-nth b 1)))) (jolt-vector _o$4590 _o$4591))))) (_a$4594 (jolt-get node (keyword #f "bindings")))) (jolt-invoke _a$4592 _a$4593 _a$4594))) (_a$4598 (keyword #f "body")) (_a$4599 (jolt-invoke f (jolt-get node (keyword #f "body"))))) (jolt-assoc _a$4595 _a$4596 _a$4597 _a$4598 _a$4599)) (if (jolt= op (keyword #f "recur")) (jolt-assoc node (keyword #f "args") (jolt-invoke (var-deref "clojure.core" "mapv") f (jolt-get node (keyword #f "args")))) (if (jolt= op (keyword #f "fn")) (jolt-assoc node (keyword #f "arities") (let* ((_a$4601 (var-deref "clojure.core" "mapv")) (_a$4602 (lambda (a) (let fnrec4600 ((a a)) (jolt-assoc a (keyword #f "body") (jolt-invoke f (jolt-get a (keyword #f "body"))))))) (_a$4603 (jolt-get node (keyword #f "arities")))) (jolt-invoke _a$4601 _a$4602 _a$4603))) (if (jolt= op (keyword #f "def")) (jolt-assoc node (keyword #f "init") (jolt-invoke f (jolt-get node (keyword #f "init")))) (if (jolt= op (keyword #f "host-call")) (let* ((_a$4604 node) (_a$4605 (keyword #f "target")) (_a$4606 (jolt-invoke f (jolt-get node (keyword #f "target")))) (_a$4607 (keyword #f "args")) (_a$4608 (jolt-invoke (var-deref "clojure.core" "mapv") f (jolt-get node (keyword #f "args"))))) (jolt-assoc _a$4604 _a$4605 _a$4606 _a$4607 _a$4608)) (if (jolt= op (keyword #f "host-new")) (jolt-assoc node (keyword #f "args") (jolt-invoke (var-deref "clojure.core" "mapv") f (jolt-get node (keyword #f "args")))) (if (jolt= op (keyword #f "try")) (let* ((n (jolt-assoc node (keyword #f "body") (jolt-invoke f (jolt-get node (keyword #f "body"))))) (n (if (jolt-truthy? (jolt-get node (keyword #f "catch-body"))) (jolt-assoc n (keyword #f "catch-body") (jolt-invoke f (jolt-get node (keyword #f "catch-body")))) n)) (n (if (jolt-truthy? (jolt-get node (keyword #f "finally"))) (jolt-assoc n (keyword #f "finally") (jolt-invoke f (jolt-get node (keyword #f "finally")))) n))) n) (if (jolt-truthy? (keyword #f "else")) node jolt-nil)))))))))))))))))))))))) map-ir-children))) + (def-var! "jolt.ir" "map-ir-children" (letrec ((map-ir-children (lambda (f node) (let fnrec4559 ((f f) (node node)) (let* ((op (jolt-get node (keyword #f "op")))) (if (jolt= op (keyword #f "if")) (let* ((_a$4560 node) (_a$4561 (keyword #f "test")) (_a$4562 (jolt-invoke f (jolt-get node (keyword #f "test")))) (_a$4563 (keyword #f "then")) (_a$4564 (jolt-invoke f (jolt-get node (keyword #f "then")))) (_a$4565 (keyword #f "else")) (_a$4566 (jolt-invoke f (jolt-get node (keyword #f "else"))))) (jolt-assoc _a$4560 _a$4561 _a$4562 _a$4563 _a$4564 _a$4565 _a$4566)) (if (jolt= op (keyword #f "do")) (let* ((_a$4567 node) (_a$4568 (keyword #f "statements")) (_a$4569 (jolt-invoke (var-deref "clojure.core" "mapv") f (jolt-get node (keyword #f "statements")))) (_a$4570 (keyword #f "ret")) (_a$4571 (jolt-invoke f (jolt-get node (keyword #f "ret"))))) (jolt-assoc _a$4567 _a$4568 _a$4569 _a$4570 _a$4571)) (if (jolt= op (keyword #f "throw")) (jolt-assoc node (keyword #f "expr") (jolt-invoke f (jolt-get node (keyword #f "expr")))) (if (jolt= op (keyword #f "set-var")) (jolt-assoc node (keyword #f "val") (jolt-invoke f (jolt-get node (keyword #f "val")))) (if (jolt= op (keyword #f "set-field")) (let* ((_a$4572 node) (_a$4573 (keyword #f "obj")) (_a$4574 (jolt-invoke f (jolt-get node (keyword #f "obj")))) (_a$4575 (keyword #f "val")) (_a$4576 (jolt-invoke f (jolt-get node (keyword #f "val"))))) (jolt-assoc _a$4572 _a$4573 _a$4574 _a$4575 _a$4576)) (if (jolt= op (keyword #f "defmacro")) (jolt-assoc node (keyword #f "fn") (jolt-invoke f (jolt-get node (keyword #f "fn")))) (if (jolt= op (keyword #f "ffi-callable")) (jolt-assoc node (keyword #f "fn") (jolt-invoke f (jolt-get node (keyword #f "fn")))) (if (jolt= op (keyword #f "invoke")) (let* ((_a$4577 node) (_a$4578 (keyword #f "fn")) (_a$4579 (jolt-invoke f (jolt-get node (keyword #f "fn")))) (_a$4580 (keyword #f "args")) (_a$4581 (jolt-invoke (var-deref "clojure.core" "mapv") f (jolt-get node (keyword #f "args"))))) (jolt-assoc _a$4577 _a$4578 _a$4579 _a$4580 _a$4581)) (if (jolt= op (keyword #f "vector")) (jolt-assoc node (keyword #f "items") (jolt-invoke (var-deref "clojure.core" "mapv") f (jolt-get node (keyword #f "items")))) (if (jolt= op (keyword #f "set")) (jolt-assoc node (keyword #f "items") (jolt-invoke (var-deref "clojure.core" "mapv") f (jolt-get node (keyword #f "items")))) (if (jolt= op (keyword #f "map")) (jolt-assoc node (keyword #f "pairs") (let* ((_a$4585 (var-deref "clojure.core" "mapv")) (_a$4586 (lambda (pr) (let fnrec4582 ((pr pr)) (let* ((_o$4583 (jolt-invoke f (jolt-nth pr 0))) (_o$4584 (jolt-invoke f (jolt-nth pr 1)))) (jolt-vector _o$4583 _o$4584))))) (_a$4587 (jolt-get node (keyword #f "pairs")))) (jolt-invoke _a$4585 _a$4586 _a$4587))) (if (jolt= op (keyword #f "let")) (let* ((_a$4594 node) (_a$4595 (keyword #f "bindings")) (_a$4596 (let* ((_a$4591 (var-deref "clojure.core" "mapv")) (_a$4592 (lambda (b) (let fnrec4588 ((b b)) (let* ((_o$4589 (jolt-nth b 0)) (_o$4590 (jolt-invoke f (jolt-nth b 1)))) (jolt-vector _o$4589 _o$4590))))) (_a$4593 (jolt-get node (keyword #f "bindings")))) (jolt-invoke _a$4591 _a$4592 _a$4593))) (_a$4597 (keyword #f "body")) (_a$4598 (jolt-invoke f (jolt-get node (keyword #f "body"))))) (jolt-assoc _a$4594 _a$4595 _a$4596 _a$4597 _a$4598)) (if (jolt= op (keyword #f "loop")) (let* ((_a$4605 node) (_a$4606 (keyword #f "bindings")) (_a$4607 (let* ((_a$4602 (var-deref "clojure.core" "mapv")) (_a$4603 (lambda (b) (let fnrec4599 ((b b)) (let* ((_o$4600 (jolt-nth b 0)) (_o$4601 (jolt-invoke f (jolt-nth b 1)))) (jolt-vector _o$4600 _o$4601))))) (_a$4604 (jolt-get node (keyword #f "bindings")))) (jolt-invoke _a$4602 _a$4603 _a$4604))) (_a$4608 (keyword #f "body")) (_a$4609 (jolt-invoke f (jolt-get node (keyword #f "body"))))) (jolt-assoc _a$4605 _a$4606 _a$4607 _a$4608 _a$4609)) (if (jolt= op (keyword #f "recur")) (jolt-assoc node (keyword #f "args") (jolt-invoke (var-deref "clojure.core" "mapv") f (jolt-get node (keyword #f "args")))) (if (jolt= op (keyword #f "fn")) (jolt-assoc node (keyword #f "arities") (let* ((_a$4611 (var-deref "clojure.core" "mapv")) (_a$4612 (lambda (a) (let fnrec4610 ((a a)) (jolt-assoc a (keyword #f "body") (jolt-invoke f (jolt-get a (keyword #f "body"))))))) (_a$4613 (jolt-get node (keyword #f "arities")))) (jolt-invoke _a$4611 _a$4612 _a$4613))) (if (jolt= op (keyword #f "def")) (jolt-assoc node (keyword #f "init") (jolt-invoke f (jolt-get node (keyword #f "init")))) (if (jolt= op (keyword #f "host-call")) (let* ((_a$4614 node) (_a$4615 (keyword #f "target")) (_a$4616 (jolt-invoke f (jolt-get node (keyword #f "target")))) (_a$4617 (keyword #f "args")) (_a$4618 (jolt-invoke (var-deref "clojure.core" "mapv") f (jolt-get node (keyword #f "args"))))) (jolt-assoc _a$4614 _a$4615 _a$4616 _a$4617 _a$4618)) (if (jolt= op (keyword #f "host-new")) (jolt-assoc node (keyword #f "args") (jolt-invoke (var-deref "clojure.core" "mapv") f (jolt-get node (keyword #f "args")))) (if (jolt= op (keyword #f "try")) (let* ((n (jolt-assoc node (keyword #f "body") (jolt-invoke f (jolt-get node (keyword #f "body"))))) (n (if (jolt-truthy? (jolt-get node (keyword #f "catch-body"))) (jolt-assoc n (keyword #f "catch-body") (jolt-invoke f (jolt-get node (keyword #f "catch-body")))) n)) (n (if (jolt-truthy? (jolt-get node (keyword #f "finally"))) (jolt-assoc n (keyword #f "finally") (jolt-invoke f (jolt-get node (keyword #f "finally")))) n))) n) (if (jolt-truthy? (keyword #f "else")) node jolt-nil))))))))))))))))))))))))) map-ir-children))) (guard (e (#t #f)) - (def-var! "jolt.ir" "reduce-ir-children" (letrec ((reduce-ir-children (lambda (f acc node) (let fnrec4609 ((f f) (acc acc) (node node)) (let* ((op (jolt-get node (keyword #f "op")))) (if (jolt= op (keyword #f "if")) (let* ((_a$4613 f) (_a$4614 (let* ((_a$4610 f) (_a$4611 (jolt-invoke f acc (jolt-get node (keyword #f "test")))) (_a$4612 (jolt-get node (keyword #f "then")))) (jolt-invoke _a$4610 _a$4611 _a$4612))) (_a$4615 (jolt-get node (keyword #f "else")))) (jolt-invoke _a$4613 _a$4614 _a$4615)) (if (jolt= op (keyword #f "do")) (let* ((_a$4616 f) (_a$4617 (jolt-reduce f acc (jolt-get node (keyword #f "statements")))) (_a$4618 (jolt-get node (keyword #f "ret")))) (jolt-invoke _a$4616 _a$4617 _a$4618)) (if (jolt= op (keyword #f "throw")) (jolt-invoke f acc (jolt-get node (keyword #f "expr"))) (if (jolt= op (keyword #f "set-var")) (jolt-invoke f acc (jolt-get node (keyword #f "val"))) (if (jolt= op (keyword #f "set-field")) (let* ((_a$4619 f) (_a$4620 (jolt-invoke f acc (jolt-get node (keyword #f "obj")))) (_a$4621 (jolt-get node (keyword #f "val")))) (jolt-invoke _a$4619 _a$4620 _a$4621)) (if (jolt= op (keyword #f "defmacro")) (jolt-invoke f acc (jolt-get node (keyword #f "fn"))) (if (jolt= op (keyword #f "invoke")) (let* ((_a$4622 f) (_a$4623 (jolt-invoke f acc (jolt-get node (keyword #f "fn")))) (_a$4624 (jolt-get node (keyword #f "args")))) (jolt-reduce _a$4622 _a$4623 _a$4624)) (if (jolt= op (keyword #f "vector")) (jolt-reduce f acc (jolt-get node (keyword #f "items"))) (if (jolt= op (keyword #f "set")) (jolt-reduce f acc (jolt-get node (keyword #f "items"))) (if (jolt= op (keyword #f "map")) (let* ((_a$4629 (lambda (a pr) (let fnrec4625 ((a a) (pr pr)) (let* ((_a$4626 f) (_a$4627 (jolt-invoke f a (jolt-nth pr 0))) (_a$4628 (jolt-nth pr 1))) (jolt-invoke _a$4626 _a$4627 _a$4628))))) (_a$4630 acc) (_a$4631 (jolt-get node (keyword #f "pairs")))) (jolt-reduce _a$4629 _a$4630 _a$4631)) (if (jolt= op (keyword #f "let")) (let* ((_a$4636 f) (_a$4637 (let* ((_a$4633 (lambda (a b) (let fnrec4632 ((a a) (b b)) (jolt-invoke f a (jolt-nth b 1))))) (_a$4634 acc) (_a$4635 (jolt-get node (keyword #f "bindings")))) (jolt-reduce _a$4633 _a$4634 _a$4635))) (_a$4638 (jolt-get node (keyword #f "body")))) (jolt-invoke _a$4636 _a$4637 _a$4638)) (if (jolt= op (keyword #f "loop")) (let* ((_a$4643 f) (_a$4644 (let* ((_a$4640 (lambda (a b) (let fnrec4639 ((a a) (b b)) (jolt-invoke f a (jolt-nth b 1))))) (_a$4641 acc) (_a$4642 (jolt-get node (keyword #f "bindings")))) (jolt-reduce _a$4640 _a$4641 _a$4642))) (_a$4645 (jolt-get node (keyword #f "body")))) (jolt-invoke _a$4643 _a$4644 _a$4645)) (if (jolt= op (keyword #f "recur")) (jolt-reduce f acc (jolt-get node (keyword #f "args"))) (if (jolt= op (keyword #f "fn")) (let* ((_a$4647 (lambda (a ar) (let fnrec4646 ((a a) (ar ar)) (jolt-invoke f a (jolt-get ar (keyword #f "body")))))) (_a$4648 acc) (_a$4649 (jolt-get node (keyword #f "arities")))) (jolt-reduce _a$4647 _a$4648 _a$4649)) (if (jolt= op (keyword #f "def")) (if (jolt-truthy? (jolt-get node (keyword #f "init"))) (jolt-invoke f acc (jolt-get node (keyword #f "init"))) acc) (if (jolt= op (keyword #f "host-call")) (let* ((_a$4650 f) (_a$4651 (jolt-invoke f acc (jolt-get node (keyword #f "target")))) (_a$4652 (jolt-get node (keyword #f "args")))) (jolt-reduce _a$4650 _a$4651 _a$4652)) (if (jolt= op (keyword #f "host-new")) (jolt-reduce f acc (jolt-get node (keyword #f "args"))) (if (jolt= op (keyword #f "try")) (let* ((a (jolt-invoke f acc (jolt-get node (keyword #f "body")))) (a (if (jolt-truthy? (jolt-get node (keyword #f "catch-body"))) (jolt-invoke f a (jolt-get node (keyword #f "catch-body"))) a)) (a (if (jolt-truthy? (jolt-get node (keyword #f "finally"))) (jolt-invoke f a (jolt-get node (keyword #f "finally"))) a))) a) (if (jolt-truthy? (keyword #f "else")) acc jolt-nil)))))))))))))))))))))))) reduce-ir-children))) + (def-var! "jolt.ir" "reduce-ir-children" (letrec ((reduce-ir-children (lambda (f acc node) (let fnrec4619 ((f f) (acc acc) (node node)) (let* ((op (jolt-get node (keyword #f "op")))) (if (jolt= op (keyword #f "if")) (let* ((_a$4623 f) (_a$4624 (let* ((_a$4620 f) (_a$4621 (jolt-invoke f acc (jolt-get node (keyword #f "test")))) (_a$4622 (jolt-get node (keyword #f "then")))) (jolt-invoke _a$4620 _a$4621 _a$4622))) (_a$4625 (jolt-get node (keyword #f "else")))) (jolt-invoke _a$4623 _a$4624 _a$4625)) (if (jolt= op (keyword #f "do")) (let* ((_a$4626 f) (_a$4627 (jolt-reduce f acc (jolt-get node (keyword #f "statements")))) (_a$4628 (jolt-get node (keyword #f "ret")))) (jolt-invoke _a$4626 _a$4627 _a$4628)) (if (jolt= op (keyword #f "throw")) (jolt-invoke f acc (jolt-get node (keyword #f "expr"))) (if (jolt= op (keyword #f "set-var")) (jolt-invoke f acc (jolt-get node (keyword #f "val"))) (if (jolt= op (keyword #f "set-field")) (let* ((_a$4629 f) (_a$4630 (jolt-invoke f acc (jolt-get node (keyword #f "obj")))) (_a$4631 (jolt-get node (keyword #f "val")))) (jolt-invoke _a$4629 _a$4630 _a$4631)) (if (jolt= op (keyword #f "defmacro")) (jolt-invoke f acc (jolt-get node (keyword #f "fn"))) (if (jolt= op (keyword #f "ffi-callable")) (jolt-invoke f acc (jolt-get node (keyword #f "fn"))) (if (jolt= op (keyword #f "invoke")) (let* ((_a$4632 f) (_a$4633 (jolt-invoke f acc (jolt-get node (keyword #f "fn")))) (_a$4634 (jolt-get node (keyword #f "args")))) (jolt-reduce _a$4632 _a$4633 _a$4634)) (if (jolt= op (keyword #f "vector")) (jolt-reduce f acc (jolt-get node (keyword #f "items"))) (if (jolt= op (keyword #f "set")) (jolt-reduce f acc (jolt-get node (keyword #f "items"))) (if (jolt= op (keyword #f "map")) (let* ((_a$4639 (lambda (a pr) (let fnrec4635 ((a a) (pr pr)) (let* ((_a$4636 f) (_a$4637 (jolt-invoke f a (jolt-nth pr 0))) (_a$4638 (jolt-nth pr 1))) (jolt-invoke _a$4636 _a$4637 _a$4638))))) (_a$4640 acc) (_a$4641 (jolt-get node (keyword #f "pairs")))) (jolt-reduce _a$4639 _a$4640 _a$4641)) (if (jolt= op (keyword #f "let")) (let* ((_a$4646 f) (_a$4647 (let* ((_a$4643 (lambda (a b) (let fnrec4642 ((a a) (b b)) (jolt-invoke f a (jolt-nth b 1))))) (_a$4644 acc) (_a$4645 (jolt-get node (keyword #f "bindings")))) (jolt-reduce _a$4643 _a$4644 _a$4645))) (_a$4648 (jolt-get node (keyword #f "body")))) (jolt-invoke _a$4646 _a$4647 _a$4648)) (if (jolt= op (keyword #f "loop")) (let* ((_a$4653 f) (_a$4654 (let* ((_a$4650 (lambda (a b) (let fnrec4649 ((a a) (b b)) (jolt-invoke f a (jolt-nth b 1))))) (_a$4651 acc) (_a$4652 (jolt-get node (keyword #f "bindings")))) (jolt-reduce _a$4650 _a$4651 _a$4652))) (_a$4655 (jolt-get node (keyword #f "body")))) (jolt-invoke _a$4653 _a$4654 _a$4655)) (if (jolt= op (keyword #f "recur")) (jolt-reduce f acc (jolt-get node (keyword #f "args"))) (if (jolt= op (keyword #f "fn")) (let* ((_a$4657 (lambda (a ar) (let fnrec4656 ((a a) (ar ar)) (jolt-invoke f a (jolt-get ar (keyword #f "body")))))) (_a$4658 acc) (_a$4659 (jolt-get node (keyword #f "arities")))) (jolt-reduce _a$4657 _a$4658 _a$4659)) (if (jolt= op (keyword #f "def")) (if (jolt-truthy? (jolt-get node (keyword #f "init"))) (jolt-invoke f acc (jolt-get node (keyword #f "init"))) acc) (if (jolt= op (keyword #f "host-call")) (let* ((_a$4660 f) (_a$4661 (jolt-invoke f acc (jolt-get node (keyword #f "target")))) (_a$4662 (jolt-get node (keyword #f "args")))) (jolt-reduce _a$4660 _a$4661 _a$4662)) (if (jolt= op (keyword #f "host-new")) (jolt-reduce f acc (jolt-get node (keyword #f "args"))) (if (jolt= op (keyword #f "try")) (let* ((a (jolt-invoke f acc (jolt-get node (keyword #f "body")))) (a (if (jolt-truthy? (jolt-get node (keyword #f "catch-body"))) (jolt-invoke f a (jolt-get node (keyword #f "catch-body"))) a)) (a (if (jolt-truthy? (jolt-get node (keyword #f "finally"))) (jolt-invoke f a (jolt-get node (keyword #f "finally"))) a))) a) (if (jolt-truthy? (keyword #f "else")) acc jolt-nil))))))))))))))))))))))))) reduce-ir-children))) (guard (e (#t #f)) (declare-var! "jolt.analyzer" "analyze")) (guard (e (#t #f)) - (def-var-with-meta! "jolt.analyzer" "handled" (let* ((_o$4653 "quote") (_o$4654 "if") (_o$4655 "do") (_o$4656 "def") (_o$4657 "fn*") (_o$4658 "let*") (_o$4659 "loop*") (_o$4660 "recur") (_o$4661 "throw") (_o$4662 "try") (_o$4663 "syntax-quote") (_o$4664 "var") (_o$4665 "letfn") (_o$4666 "set!") (_o$4667 "defmacro")) (jolt-hash-set _o$4653 _o$4654 _o$4655 _o$4656 _o$4657 _o$4658 _o$4659 _o$4660 _o$4661 _o$4662 _o$4663 _o$4664 _o$4665 _o$4666 _o$4667)) (jolt-hash-map (keyword #f "private") #t))) + (def-var-with-meta! "jolt.analyzer" "handled" (let* ((_o$4663 "quote") (_o$4664 "if") (_o$4665 "do") (_o$4666 "def") (_o$4667 "fn*") (_o$4668 "let*") (_o$4669 "loop*") (_o$4670 "recur") (_o$4671 "throw") (_o$4672 "try") (_o$4673 "syntax-quote") (_o$4674 "var") (_o$4675 "letfn") (_o$4676 "set!") (_o$4677 "defmacro")) (jolt-hash-set _o$4663 _o$4664 _o$4665 _o$4666 _o$4667 _o$4668 _o$4669 _o$4670 _o$4671 _o$4672 _o$4673 _o$4674 _o$4675 _o$4676 _o$4677)) (jolt-hash-map (keyword #f "private") #t))) (guard (e (#t #f)) - (def-var! "jolt.analyzer" "uncompilable" (letrec ((uncompilable (lambda (why) (let fnrec4668 ((why why)) (jolt-throw (jolt-invoke (var-deref "clojure.core" "str") "jolt/uncompilable: " why)))))) uncompilable))) + (def-var! "jolt.analyzer" "uncompilable" (letrec ((uncompilable (lambda (why) (let fnrec4678 ((why why)) (jolt-throw (jolt-invoke (var-deref "clojure.core" "str") "jolt/uncompilable: " why)))))) uncompilable))) (guard (e (#t #f)) (def-var-with-meta! "jolt.analyzer" "gensym-counter" (jolt-invoke (var-deref "clojure.core" "atom") 0) (jolt-hash-map (keyword #f "private") #t))) (guard (e (#t #f)) - (def-var! "jolt.analyzer" "gen-name" (letrec ((gen-name (lambda (prefix) (let fnrec4669 ((prefix prefix)) (let* ((n (jolt-invoke (var-deref "clojure.core" "deref") (var-deref "jolt.analyzer" "gensym-counter")))) (begin (jolt-invoke (var-deref "clojure.core" "swap!") (var-deref "jolt.analyzer" "gensym-counter") jolt-inc) (jolt-invoke (var-deref "clojure.core" "str") "_r$" prefix n))))))) gen-name))) + (def-var! "jolt.analyzer" "gen-name" (letrec ((gen-name (lambda (prefix) (let fnrec4679 ((prefix prefix)) (let* ((n (jolt-invoke (var-deref "clojure.core" "deref") (var-deref "jolt.analyzer" "gensym-counter")))) (begin (jolt-invoke (var-deref "clojure.core" "swap!") (var-deref "jolt.analyzer" "gensym-counter") jolt-inc) (jolt-invoke (var-deref "clojure.core" "str") "_r$" prefix n))))))) gen-name))) (guard (e (#t #f)) - (def-var! "jolt.analyzer" "empty-env" (letrec ((empty-env (lambda () (let fnrec4670 () (let* ((_o$4671 (keyword #f "locals")) (_o$4672 (jolt-hash-set)) (_o$4673 (keyword #f "hints")) (_o$4674 (jolt-hash-map))) (jolt-hash-map _o$4671 _o$4672 _o$4673 _o$4674)))))) empty-env))) + (def-var! "jolt.analyzer" "empty-env" (letrec ((empty-env (lambda () (let fnrec4680 () (let* ((_o$4681 (keyword #f "locals")) (_o$4682 (jolt-hash-set)) (_o$4683 (keyword #f "hints")) (_o$4684 (jolt-hash-map))) (jolt-hash-map _o$4681 _o$4682 _o$4683 _o$4684)))))) empty-env))) (guard (e (#t #f)) - (def-var! "jolt.analyzer" "local?" (letrec ((local? (lambda (env nm) (let fnrec4675 ((env env) (nm nm)) (jolt-contains? (jolt-get env (keyword #f "locals")) nm))))) local?))) + (def-var! "jolt.analyzer" "local?" (letrec ((local? (lambda (env nm) (let fnrec4685 ((env env) (nm nm)) (jolt-contains? (jolt-get env (keyword #f "locals")) nm))))) local?))) (guard (e (#t #f)) - (def-var! "jolt.analyzer" "add-locals" (letrec ((add-locals (lambda (env names) (let fnrec4676 ((env env) (names names)) (jolt-invoke (var-deref "clojure.core" "update") env (keyword #f "locals") (lambda (p__47_) (let fnrec4677 ((p__47_ p__47_)) (jolt-reduce jolt-conj p__47_ names)))))))) add-locals))) + (def-var! "jolt.analyzer" "add-locals" (letrec ((add-locals (lambda (env names) (let fnrec4686 ((env env) (names names)) (jolt-invoke (var-deref "clojure.core" "update") env (keyword #f "locals") (lambda (p__47_) (let fnrec4687 ((p__47_ p__47_)) (jolt-reduce jolt-conj p__47_ names)))))))) add-locals))) (guard (e (#t #f)) - (def-var! "jolt.analyzer" "with-recur" (letrec ((with-recur (lambda (env name) (let fnrec4678 ((env env) (name name)) (jolt-assoc env (keyword #f "recur") name))))) with-recur))) + (def-var! "jolt.analyzer" "with-recur" (letrec ((with-recur (lambda (env name) (let fnrec4688 ((env env) (name name)) (jolt-assoc env (keyword #f "recur") name))))) with-recur))) (guard (e (#t #f)) - (def-var! "jolt.analyzer" "hint-of" (letrec ((hint-of (lambda (ctx sym) (let fnrec4679 ((ctx ctx) (sym sym)) (let* ((m (jolt-invoke (var-deref "jolt.host" "form-sym-meta") sym))) (if (jolt-truthy? (jolt-invoke (var-deref "clojure.core" "nil?") m)) jolt-nil (if (jolt-truthy? (jolt-get m (keyword #f "struct"))) (keyword #f "struct") (if (jolt-truthy? (keyword #f "else")) (let* ((t (jolt-get m (keyword #f "tag")))) (if (jolt-truthy? (let* ((and__13__auto t)) (if (jolt-truthy? and__13__auto) (jolt-invoke (var-deref "jolt.host" "record-type?") ctx t) and__13__auto))) (keyword #f "struct") jolt-nil)) jolt-nil)))))))) hint-of))) + (def-var! "jolt.analyzer" "hint-of" (letrec ((hint-of (lambda (ctx sym) (let fnrec4689 ((ctx ctx) (sym sym)) (let* ((m (jolt-invoke (var-deref "jolt.host" "form-sym-meta") sym))) (if (jolt-truthy? (jolt-invoke (var-deref "clojure.core" "nil?") m)) jolt-nil (if (jolt-truthy? (jolt-get m (keyword #f "struct"))) (keyword #f "struct") (if (jolt-truthy? (keyword #f "else")) (let* ((t (jolt-get m (keyword #f "tag")))) (if (jolt-truthy? (let* ((and__13__auto t)) (if (jolt-truthy? and__13__auto) (jolt-invoke (var-deref "jolt.host" "record-type?") ctx t) and__13__auto))) (keyword #f "struct") jolt-nil)) jolt-nil)))))))) hint-of))) (guard (e (#t #f)) - (def-var! "jolt.analyzer" "add-hint" (letrec ((add-hint (lambda (env nm h) (let fnrec4680 ((env env) (nm nm) (h h)) (if (jolt-truthy? h) (jolt-assoc env (keyword #f "hints") (jolt-assoc (jolt-get env (keyword #f "hints")) nm h)) env))))) add-hint))) + (def-var! "jolt.analyzer" "add-hint" (letrec ((add-hint (lambda (env nm h) (let fnrec4690 ((env env) (nm nm) (h h)) (if (jolt-truthy? h) (jolt-assoc env (keyword #f "hints") (jolt-assoc (jolt-get env (keyword #f "hints")) nm h)) env))))) add-hint))) (guard (e (#t #f)) - (def-var! "jolt.analyzer" "phint-of" (letrec ((phint-of (lambda (ctx sym) (let fnrec4681 ((ctx ctx) (sym sym)) (let* ((m (jolt-invoke (var-deref "jolt.host" "form-sym-meta") sym))) (if (jolt-truthy? m) (let* ((t (jolt-get m (keyword #f "tag")))) (if (jolt-truthy? t) (jolt-invoke (var-deref "jolt.host" "record-ctor-key") ctx t) jolt-nil)) jolt-nil)))))) phint-of))) + (def-var! "jolt.analyzer" "phint-of" (letrec ((phint-of (lambda (ctx sym) (let fnrec4691 ((ctx ctx) (sym sym)) (let* ((m (jolt-invoke (var-deref "jolt.host" "form-sym-meta") sym))) (if (jolt-truthy? m) (let* ((t (jolt-get m (keyword #f "tag")))) (if (jolt-truthy? t) (jolt-invoke (var-deref "jolt.host" "record-ctor-key") ctx t) jolt-nil)) jolt-nil)))))) phint-of))) (guard (e (#t #f)) - (def-var! "jolt.analyzer" "analyze-seq" (letrec ((analyze-seq (lambda (ctx forms env) (let fnrec4682 ((ctx ctx) (forms forms) (env env)) (let* ((v (jolt-invoke (var-deref "clojure.core" "mapv") (lambda (p__48_) (let fnrec4683 ((p__48_ p__48_)) (jolt-invoke (var-deref "jolt.analyzer" "analyze") ctx p__48_ env))) forms)) (n (jolt-count v))) (if (jolt-zero? n) (jolt-invoke (var-deref "jolt.ir" "const") jolt-nil) (if (jolt= 1 n) (jolt-first v) (if (jolt-truthy? (keyword #f "else")) (let* ((_a$4684 (var-deref "jolt.ir" "do-node")) (_a$4685 (jolt-invoke (var-deref "clojure.core" "subvec") v 0 (jolt-dec n))) (_a$4686 (jolt-peek v))) (jolt-invoke _a$4684 _a$4685 _a$4686)) jolt-nil)))))))) analyze-seq))) + (def-var! "jolt.analyzer" "analyze-seq" (letrec ((analyze-seq (lambda (ctx forms env) (let fnrec4692 ((ctx ctx) (forms forms) (env env)) (let* ((v (jolt-invoke (var-deref "clojure.core" "mapv") (lambda (p__48_) (let fnrec4693 ((p__48_ p__48_)) (jolt-invoke (var-deref "jolt.analyzer" "analyze") ctx p__48_ env))) forms)) (n (jolt-count v))) (if (jolt-zero? n) (jolt-invoke (var-deref "jolt.ir" "const") jolt-nil) (if (jolt= 1 n) (jolt-first v) (if (jolt-truthy? (keyword #f "else")) (let* ((_a$4694 (var-deref "jolt.ir" "do-node")) (_a$4695 (jolt-invoke (var-deref "clojure.core" "subvec") v 0 (jolt-dec n))) (_a$4696 (jolt-peek v))) (jolt-invoke _a$4694 _a$4695 _a$4696)) jolt-nil)))))))) analyze-seq))) (guard (e (#t #f)) - (def-var! "jolt.analyzer" "analyze-bindings" (letrec ((analyze-bindings (lambda (ctx bvec env) (let fnrec4687 ((ctx ctx) (bvec bvec) (env env)) (let* ((i 0) (env env) (pairs (jolt-vector))) (let loop4688 ((i i) (env env) (pairs pairs)) (if (< i (jolt-count bvec)) (let* ((bsym (jolt-nth bvec i))) (begin (if (jolt-not (jolt-invoke (var-deref "jolt.host" "form-sym?") bsym)) (jolt-invoke (var-deref "jolt.analyzer" "uncompilable") "destructuring binding") jolt-nil) (let* ((nm (jolt-invoke (var-deref "jolt.host" "form-sym-name") bsym)) (init (jolt-invoke (var-deref "jolt.analyzer" "analyze") ctx (jolt-nth bvec (jolt-inc i)) env))) (let* ((_a$4695 (+ i 2)) (_a$4696 (let* ((_a$4689 (var-deref "jolt.analyzer" "add-hint")) (_a$4690 (jolt-invoke (var-deref "jolt.analyzer" "add-locals") env (jolt-vector nm))) (_a$4691 nm) (_a$4692 (jolt-invoke (var-deref "jolt.analyzer" "hint-of") ctx bsym))) (jolt-invoke _a$4689 _a$4690 _a$4691 _a$4692))) (_a$4697 (jolt-conj pairs (let* ((_o$4693 nm) (_o$4694 init)) (jolt-vector _o$4693 _o$4694))))) (loop4688 _a$4695 _a$4696 _a$4697))))) (let* ((_o$4698 pairs) (_o$4699 env)) (jolt-vector _o$4698 _o$4699))))))))) analyze-bindings))) + (def-var! "jolt.analyzer" "analyze-bindings" (letrec ((analyze-bindings (lambda (ctx bvec env) (let fnrec4697 ((ctx ctx) (bvec bvec) (env env)) (let* ((i 0) (env env) (pairs (jolt-vector))) (let loop4698 ((i i) (env env) (pairs pairs)) (if (< i (jolt-count bvec)) (let* ((bsym (jolt-nth bvec i))) (begin (if (jolt-not (jolt-invoke (var-deref "jolt.host" "form-sym?") bsym)) (jolt-invoke (var-deref "jolt.analyzer" "uncompilable") "destructuring binding") jolt-nil) (let* ((nm (jolt-invoke (var-deref "jolt.host" "form-sym-name") bsym)) (init (jolt-invoke (var-deref "jolt.analyzer" "analyze") ctx (jolt-nth bvec (jolt-inc i)) env))) (let* ((_a$4705 (+ i 2)) (_a$4706 (let* ((_a$4699 (var-deref "jolt.analyzer" "add-hint")) (_a$4700 (jolt-invoke (var-deref "jolt.analyzer" "add-locals") env (jolt-vector nm))) (_a$4701 nm) (_a$4702 (jolt-invoke (var-deref "jolt.analyzer" "hint-of") ctx bsym))) (jolt-invoke _a$4699 _a$4700 _a$4701 _a$4702))) (_a$4707 (jolt-conj pairs (let* ((_o$4703 nm) (_o$4704 init)) (jolt-vector _o$4703 _o$4704))))) (loop4698 _a$4705 _a$4706 _a$4707))))) (let* ((_o$4708 pairs) (_o$4709 env)) (jolt-vector _o$4708 _o$4709))))))))) analyze-bindings))) (guard (e (#t #f)) - (def-var! "jolt.analyzer" "parse-params" (letrec ((parse-params (lambda (ctx pvec) (let fnrec4700 ((ctx ctx) (pvec pvec)) (let* ((i 0) (fixed (jolt-vector)) (rest-name jolt-nil) (hints (jolt-vector)) (phints (jolt-vector))) (let loop4701 ((i i) (fixed fixed) (rest-name rest-name) (hints hints) (phints phints)) (if (< i (jolt-count pvec)) (let* ((p (jolt-nth pvec i))) (begin (if (jolt-not (jolt-invoke (var-deref "jolt.host" "form-sym?") p)) (jolt-invoke (var-deref "jolt.analyzer" "uncompilable") "destructuring fn param") jolt-nil) (if (jolt= "&" (jolt-invoke (var-deref "jolt.host" "form-sym-name") p)) (let* ((r (jolt-nth pvec (jolt-inc i)))) (begin (if (jolt-not (jolt-invoke (var-deref "jolt.host" "form-sym?") r)) (jolt-invoke (var-deref "jolt.analyzer" "uncompilable") "destructuring fn rest") jolt-nil) (let* ((_a$4702 (+ i 2)) (_a$4703 fixed) (_a$4704 (jolt-invoke (var-deref "jolt.host" "form-sym-name") r)) (_a$4705 hints) (_a$4706 phints)) (loop4701 _a$4702 _a$4703 _a$4704 _a$4705 _a$4706)))) (let* ((nm (jolt-invoke (var-deref "jolt.host" "form-sym-name") p)) (h (jolt-invoke (var-deref "jolt.analyzer" "hint-of") ctx p)) (ph (jolt-invoke (var-deref "jolt.analyzer" "phint-of") ctx p))) (let* ((_a$4711 (jolt-inc i)) (_a$4712 (jolt-conj fixed nm)) (_a$4713 rest-name) (_a$4714 (if (jolt-truthy? h) (jolt-conj hints (let* ((_o$4707 nm) (_o$4708 h)) (jolt-vector _o$4707 _o$4708))) hints)) (_a$4715 (if (jolt-truthy? ph) (jolt-conj phints (let* ((_o$4709 nm) (_o$4710 ph)) (jolt-vector _o$4709 _o$4710))) phints))) (loop4701 _a$4711 _a$4712 _a$4713 _a$4714 _a$4715)))))) (let* ((_o$4716 (keyword #f "fixed")) (_o$4717 fixed) (_o$4718 (keyword #f "rest")) (_o$4719 rest-name) (_o$4720 (keyword #f "hints")) (_o$4721 hints) (_o$4722 (keyword #f "phints")) (_o$4723 phints)) (jolt-hash-map _o$4716 _o$4717 _o$4718 _o$4719 _o$4720 _o$4721 _o$4722 _o$4723))))))))) parse-params))) + (def-var! "jolt.analyzer" "parse-params" (letrec ((parse-params (lambda (ctx pvec) (let fnrec4710 ((ctx ctx) (pvec pvec)) (let* ((i 0) (fixed (jolt-vector)) (rest-name jolt-nil) (hints (jolt-vector)) (phints (jolt-vector))) (let loop4711 ((i i) (fixed fixed) (rest-name rest-name) (hints hints) (phints phints)) (if (< i (jolt-count pvec)) (let* ((p (jolt-nth pvec i))) (begin (if (jolt-not (jolt-invoke (var-deref "jolt.host" "form-sym?") p)) (jolt-invoke (var-deref "jolt.analyzer" "uncompilable") "destructuring fn param") jolt-nil) (if (jolt= "&" (jolt-invoke (var-deref "jolt.host" "form-sym-name") p)) (let* ((r (jolt-nth pvec (jolt-inc i)))) (begin (if (jolt-not (jolt-invoke (var-deref "jolt.host" "form-sym?") r)) (jolt-invoke (var-deref "jolt.analyzer" "uncompilable") "destructuring fn rest") jolt-nil) (let* ((_a$4712 (+ i 2)) (_a$4713 fixed) (_a$4714 (jolt-invoke (var-deref "jolt.host" "form-sym-name") r)) (_a$4715 hints) (_a$4716 phints)) (loop4711 _a$4712 _a$4713 _a$4714 _a$4715 _a$4716)))) (let* ((nm (jolt-invoke (var-deref "jolt.host" "form-sym-name") p)) (h (jolt-invoke (var-deref "jolt.analyzer" "hint-of") ctx p)) (ph (jolt-invoke (var-deref "jolt.analyzer" "phint-of") ctx p))) (let* ((_a$4721 (jolt-inc i)) (_a$4722 (jolt-conj fixed nm)) (_a$4723 rest-name) (_a$4724 (if (jolt-truthy? h) (jolt-conj hints (let* ((_o$4717 nm) (_o$4718 h)) (jolt-vector _o$4717 _o$4718))) hints)) (_a$4725 (if (jolt-truthy? ph) (jolt-conj phints (let* ((_o$4719 nm) (_o$4720 ph)) (jolt-vector _o$4719 _o$4720))) phints))) (loop4711 _a$4721 _a$4722 _a$4723 _a$4724 _a$4725)))))) (let* ((_o$4726 (keyword #f "fixed")) (_o$4727 fixed) (_o$4728 (keyword #f "rest")) (_o$4729 rest-name) (_o$4730 (keyword #f "hints")) (_o$4731 hints) (_o$4732 (keyword #f "phints")) (_o$4733 phints)) (jolt-hash-map _o$4726 _o$4727 _o$4728 _o$4729 _o$4730 _o$4731 _o$4732 _o$4733))))))))) parse-params))) (guard (e (#t #f)) - (def-var! "jolt.analyzer" "uniquify-params" (letrec ((uniquify-params (lambda (names) (let fnrec4724 ((names names)) (let* ((n (jolt-count names))) (let* ((i 0) (out (jolt-vector))) (let loop4725 ((i i) (out out)) (if (< i n) (let* ((nm (jolt-nth names i)) (dup? (let* ((j (jolt-inc i))) (let loop4726 ((j j)) (if (>= j n) #f (if (jolt= nm (jolt-nth names j)) #t (if (jolt-truthy? (keyword #f "else")) (loop4726 (jolt-inc j)) jolt-nil))))))) (let* ((_a$4727 (jolt-inc i)) (_a$4728 (jolt-conj out (if (jolt-truthy? dup?) (jolt-invoke (var-deref "jolt.analyzer" "gen-name") (jolt-invoke (var-deref "clojure.core" "str") nm "_")) nm)))) (loop4725 _a$4727 _a$4728))) out)))))))) uniquify-params))) + (def-var! "jolt.analyzer" "uniquify-params" (letrec ((uniquify-params (lambda (names) (let fnrec4734 ((names names)) (let* ((n (jolt-count names))) (let* ((i 0) (out (jolt-vector))) (let loop4735 ((i i) (out out)) (if (< i n) (let* ((nm (jolt-nth names i)) (dup? (let* ((j (jolt-inc i))) (let loop4736 ((j j)) (if (>= j n) #f (if (jolt= nm (jolt-nth names j)) #t (if (jolt-truthy? (keyword #f "else")) (loop4736 (jolt-inc j)) jolt-nil))))))) (let* ((_a$4737 (jolt-inc i)) (_a$4738 (jolt-conj out (if (jolt-truthy? dup?) (jolt-invoke (var-deref "jolt.analyzer" "gen-name") (jolt-invoke (var-deref "clojure.core" "str") nm "_")) nm)))) (loop4735 _a$4737 _a$4738))) out)))))))) uniquify-params))) (guard (e (#t #f)) - (def-var! "jolt.analyzer" "analyze-arity" (letrec ((analyze-arity (lambda (ctx pvec body env fn-name) (let fnrec4729 ((ctx ctx) (pvec pvec) (body body) (env env) (fn-name fn-name)) (let* ((pp (jolt-invoke (var-deref "jolt.analyzer" "parse-params") ctx (jolt-invoke (var-deref "clojure.core" "vec") (jolt-invoke (var-deref "jolt.host" "form-vec-items") pvec)))) (fixed (jolt-invoke (var-deref "jolt.analyzer" "uniquify-params") (jolt-get pp (keyword #f "fixed")))) (rst (jolt-get pp (keyword #f "rest"))) (rname (jolt-invoke (var-deref "jolt.analyzer" "gen-name") (let* ((_a$4730 (var-deref "clojure.core" "str")) (_a$4731 (jolt-invoke (var-deref "jolt.host" "compile-ns") ctx)) (_a$4732 "/") (_a$4733 (let* ((or__14__auto fn-name)) (if (jolt-truthy? or__14__auto) or__14__auto "fn"))) (_a$4734 "--")) (jolt-invoke _a$4730 _a$4731 _a$4732 _a$4733 _a$4734)))) (names (let* ((G__41 (jolt-invoke (var-deref "clojure.core" "vec") fixed))) (let* ((G__42 (if (jolt-truthy? rst) (jolt-conj G__41 rst) G__41))) (let* ((G__43 (if (jolt-truthy? fn-name) (jolt-conj G__42 fn-name) G__42))) G__43)))) (env0 (jolt-invoke (var-deref "jolt.analyzer" "with-recur") (jolt-invoke (var-deref "jolt.analyzer" "add-locals") env names) rname)) (env* (let* ((_a$4740 (lambda (e pr) (let fnrec4735 ((e e) (pr pr)) (let* ((_a$4736 (var-deref "jolt.analyzer" "add-hint")) (_a$4737 e) (_a$4738 (jolt-nth pr 0)) (_a$4739 (jolt-nth pr 1))) (jolt-invoke _a$4736 _a$4737 _a$4738 _a$4739))))) (_a$4741 env0) (_a$4742 (jolt-get pp (keyword #f "hints")))) (jolt-reduce _a$4740 _a$4741 _a$4742))) (arity (let* ((_o$4743 (keyword #f "params")) (_o$4744 fixed) (_o$4745 (keyword #f "recur-name")) (_o$4746 rname) (_o$4747 (keyword #f "body")) (_o$4748 (jolt-invoke (var-deref "jolt.analyzer" "analyze-seq") ctx body env*))) (jolt-hash-map _o$4743 _o$4744 _o$4745 _o$4746 _o$4747 _o$4748))) (arity (if (jolt-truthy? (jolt-seq (jolt-get pp (keyword #f "phints")))) (jolt-assoc arity (keyword #f "phints") (jolt-get pp (keyword #f "phints"))) arity))) (if (jolt-truthy? rst) (jolt-assoc arity (keyword #f "rest") rst) arity)))))) analyze-arity))) + (def-var! "jolt.analyzer" "analyze-arity" (letrec ((analyze-arity (lambda (ctx pvec body env fn-name) (let fnrec4739 ((ctx ctx) (pvec pvec) (body body) (env env) (fn-name fn-name)) (let* ((pp (jolt-invoke (var-deref "jolt.analyzer" "parse-params") ctx (jolt-invoke (var-deref "clojure.core" "vec") (jolt-invoke (var-deref "jolt.host" "form-vec-items") pvec)))) (fixed (jolt-invoke (var-deref "jolt.analyzer" "uniquify-params") (jolt-get pp (keyword #f "fixed")))) (rst (jolt-get pp (keyword #f "rest"))) (rname (jolt-invoke (var-deref "jolt.analyzer" "gen-name") (let* ((_a$4740 (var-deref "clojure.core" "str")) (_a$4741 (jolt-invoke (var-deref "jolt.host" "compile-ns") ctx)) (_a$4742 "/") (_a$4743 (let* ((or__14__auto fn-name)) (if (jolt-truthy? or__14__auto) or__14__auto "fn"))) (_a$4744 "--")) (jolt-invoke _a$4740 _a$4741 _a$4742 _a$4743 _a$4744)))) (names (let* ((G__41 (jolt-invoke (var-deref "clojure.core" "vec") fixed))) (let* ((G__42 (if (jolt-truthy? rst) (jolt-conj G__41 rst) G__41))) (let* ((G__43 (if (jolt-truthy? fn-name) (jolt-conj G__42 fn-name) G__42))) G__43)))) (env0 (jolt-invoke (var-deref "jolt.analyzer" "with-recur") (jolt-invoke (var-deref "jolt.analyzer" "add-locals") env names) rname)) (env* (let* ((_a$4750 (lambda (e pr) (let fnrec4745 ((e e) (pr pr)) (let* ((_a$4746 (var-deref "jolt.analyzer" "add-hint")) (_a$4747 e) (_a$4748 (jolt-nth pr 0)) (_a$4749 (jolt-nth pr 1))) (jolt-invoke _a$4746 _a$4747 _a$4748 _a$4749))))) (_a$4751 env0) (_a$4752 (jolt-get pp (keyword #f "hints")))) (jolt-reduce _a$4750 _a$4751 _a$4752))) (arity (let* ((_o$4753 (keyword #f "params")) (_o$4754 fixed) (_o$4755 (keyword #f "recur-name")) (_o$4756 rname) (_o$4757 (keyword #f "body")) (_o$4758 (jolt-invoke (var-deref "jolt.analyzer" "analyze-seq") ctx body env*))) (jolt-hash-map _o$4753 _o$4754 _o$4755 _o$4756 _o$4757 _o$4758))) (arity (if (jolt-truthy? (jolt-seq (jolt-get pp (keyword #f "phints")))) (jolt-assoc arity (keyword #f "phints") (jolt-get pp (keyword #f "phints"))) arity))) (if (jolt-truthy? rst) (jolt-assoc arity (keyword #f "rest") rst) arity)))))) analyze-arity))) (guard (e (#t #f)) - (def-var! "jolt.analyzer" "strip-arglist-meta" (letrec ((strip-arglist-meta (lambda (form) (let fnrec4749 ((form form)) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.host" "form-list?") form)) (let* ((es (jolt-invoke (var-deref "clojure.core" "vec") (jolt-invoke (var-deref "jolt.host" "form-elements") form)))) (if (jolt-truthy? (let* ((and__13__auto (jolt= 3 (jolt-count es)))) (if (jolt-truthy? and__13__auto) (let* ((and__13__auto (jolt-invoke (var-deref "jolt.host" "form-sym?") (jolt-first es)))) (if (jolt-truthy? and__13__auto) (let* ((and__13__auto (jolt= "with-meta" (jolt-invoke (var-deref "jolt.host" "form-sym-name") (jolt-first es))))) (if (jolt-truthy? and__13__auto) (jolt-invoke (var-deref "jolt.host" "form-vec?") (jolt-nth es 1)) and__13__auto)) and__13__auto)) and__13__auto))) (jolt-nth es 1) form)) form))))) strip-arglist-meta))) + (def-var! "jolt.analyzer" "strip-arglist-meta" (letrec ((strip-arglist-meta (lambda (form) (let fnrec4759 ((form form)) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.host" "form-list?") form)) (let* ((es (jolt-invoke (var-deref "clojure.core" "vec") (jolt-invoke (var-deref "jolt.host" "form-elements") form)))) (if (jolt-truthy? (let* ((and__13__auto (jolt= 3 (jolt-count es)))) (if (jolt-truthy? and__13__auto) (let* ((and__13__auto (jolt-invoke (var-deref "jolt.host" "form-sym?") (jolt-first es)))) (if (jolt-truthy? and__13__auto) (let* ((and__13__auto (jolt= "with-meta" (jolt-invoke (var-deref "jolt.host" "form-sym-name") (jolt-first es))))) (if (jolt-truthy? and__13__auto) (jolt-invoke (var-deref "jolt.host" "form-vec?") (jolt-nth es 1)) and__13__auto)) and__13__auto)) and__13__auto))) (jolt-nth es 1) form)) form))))) strip-arglist-meta))) (guard (e (#t #f)) - (def-var! "jolt.analyzer" "analyze-fn" (letrec ((analyze-fn (lambda (ctx items env) (let fnrec4750 ((ctx ctx) (items items) (env env)) (let* ((named (jolt-invoke (var-deref "jolt.host" "form-sym?") (jolt-nth items 1))) (fn-name (if (jolt-truthy? named) (jolt-invoke (var-deref "jolt.host" "form-sym-name") (jolt-nth items 1)) jolt-nil)) (rest-items (if (jolt-truthy? named) (jolt-drop 2 items) (jolt-drop 1 items))) (first* (jolt-invoke (var-deref "jolt.analyzer" "strip-arglist-meta") (jolt-first rest-items)))) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.host" "form-vec?") first*)) (jolt-invoke (var-deref "jolt.ir" "fn-node") fn-name (jolt-vector (jolt-invoke (var-deref "jolt.analyzer" "analyze-arity") ctx first* (jolt-rest rest-items) env fn-name))) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.host" "form-list?") first*)) (jolt-invoke (var-deref "jolt.ir" "fn-node") fn-name (jolt-invoke (var-deref "clojure.core" "mapv") (lambda (clause) (let fnrec4751 ((clause clause)) (let* ((cl (jolt-invoke (var-deref "clojure.core" "vec") (jolt-invoke (var-deref "jolt.host" "form-elements") clause)))) (let* ((_a$4752 (var-deref "jolt.analyzer" "analyze-arity")) (_a$4753 ctx) (_a$4754 (jolt-invoke (var-deref "jolt.analyzer" "strip-arglist-meta") (jolt-first cl))) (_a$4755 (jolt-rest cl)) (_a$4756 env) (_a$4757 fn-name)) (jolt-invoke _a$4752 _a$4753 _a$4754 _a$4755 _a$4756 _a$4757))))) rest-items)) (if (jolt-truthy? (keyword #f "else")) (jolt-invoke (var-deref "jolt.analyzer" "uncompilable") "fn: bad params") jolt-nil)))))))) analyze-fn))) + (def-var! "jolt.analyzer" "analyze-fn" (letrec ((analyze-fn (lambda (ctx items env) (let fnrec4760 ((ctx ctx) (items items) (env env)) (let* ((named (jolt-invoke (var-deref "jolt.host" "form-sym?") (jolt-nth items 1))) (fn-name (if (jolt-truthy? named) (jolt-invoke (var-deref "jolt.host" "form-sym-name") (jolt-nth items 1)) jolt-nil)) (rest-items (if (jolt-truthy? named) (jolt-drop 2 items) (jolt-drop 1 items))) (first* (jolt-invoke (var-deref "jolt.analyzer" "strip-arglist-meta") (jolt-first rest-items)))) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.host" "form-vec?") first*)) (jolt-invoke (var-deref "jolt.ir" "fn-node") fn-name (jolt-vector (jolt-invoke (var-deref "jolt.analyzer" "analyze-arity") ctx first* (jolt-rest rest-items) env fn-name))) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.host" "form-list?") first*)) (jolt-invoke (var-deref "jolt.ir" "fn-node") fn-name (jolt-invoke (var-deref "clojure.core" "mapv") (lambda (clause) (let fnrec4761 ((clause clause)) (let* ((cl (jolt-invoke (var-deref "clojure.core" "vec") (jolt-invoke (var-deref "jolt.host" "form-elements") clause)))) (let* ((_a$4762 (var-deref "jolt.analyzer" "analyze-arity")) (_a$4763 ctx) (_a$4764 (jolt-invoke (var-deref "jolt.analyzer" "strip-arglist-meta") (jolt-first cl))) (_a$4765 (jolt-rest cl)) (_a$4766 env) (_a$4767 fn-name)) (jolt-invoke _a$4762 _a$4763 _a$4764 _a$4765 _a$4766 _a$4767))))) rest-items)) (if (jolt-truthy? (keyword #f "else")) (jolt-invoke (var-deref "jolt.analyzer" "uncompilable") "fn: bad params") jolt-nil)))))))) analyze-fn))) (guard (e (#t #f)) - (def-var! "jolt.analyzer" "analyze-try" (letrec ((analyze-try (lambda (ctx items env) (let fnrec4758 ((ctx ctx) (items items) (env env)) (let* ((clauses (jolt-rest items)) (body (jolt-invoke (var-deref "clojure.core" "atom") (jolt-vector))) (catch-sym (jolt-invoke (var-deref "clojure.core" "atom") jolt-nil)) (catch-body (jolt-invoke (var-deref "clojure.core" "atom") jolt-nil)) (finally-body (jolt-invoke (var-deref "clojure.core" "atom") jolt-nil))) (begin (begin (jolt-count (jolt-map (lambda (c) (let fnrec4759 ((c c)) (begin (let* ((head (if (jolt-truthy? (jolt-invoke (var-deref "jolt.host" "form-list?") c)) (jolt-first (jolt-invoke (var-deref "clojure.core" "vec") (jolt-invoke (var-deref "jolt.host" "form-elements") c))) jolt-nil)) (hname (if (jolt-truthy? (let* ((and__13__auto head)) (if (jolt-truthy? and__13__auto) (jolt-invoke (var-deref "jolt.host" "form-sym?") head) and__13__auto))) (jolt-invoke (var-deref "jolt.host" "form-sym-name") head) jolt-nil))) (if (jolt= hname "catch") (let* ((cl (jolt-invoke (var-deref "clojure.core" "vec") (jolt-invoke (var-deref "jolt.host" "form-elements") c)))) (begin (if (jolt-truthy? (let* ((or__14__auto (< (jolt-count cl) 3))) (if (jolt-truthy? or__14__auto) or__14__auto (jolt-not (jolt-invoke (var-deref "jolt.host" "form-sym?") (jolt-nth cl 2)))))) (jolt-throw "Unable to parse catch clause; expected (catch class binding body*)") jolt-nil) (jolt-invoke (var-deref "clojure.core" "reset!") catch-sym (jolt-invoke (var-deref "jolt.host" "form-sym-name") (jolt-nth cl 2))) (jolt-invoke (var-deref "clojure.core" "reset!") catch-body (jolt-drop 3 cl)))) (if (jolt= hname "finally") (jolt-invoke (var-deref "clojure.core" "reset!") finally-body (jolt-rest (jolt-invoke (var-deref "clojure.core" "vec") (jolt-invoke (var-deref "jolt.host" "form-elements") c)))) (if (jolt-truthy? (keyword #f "else")) (jolt-invoke (var-deref "clojure.core" "swap!") body jolt-conj c) jolt-nil)))) jolt-nil))) clauses)) jolt-nil) (let* ((n (let* ((_o$4760 (keyword #f "op")) (_o$4761 (keyword #f "try")) (_o$4762 (keyword #f "body")) (_o$4763 (jolt-invoke (var-deref "jolt.analyzer" "analyze-seq") ctx (jolt-invoke (var-deref "clojure.core" "deref") body) env))) (jolt-hash-map _o$4760 _o$4761 _o$4762 _o$4763))) (n (if (jolt-truthy? (jolt-invoke (var-deref "clojure.core" "deref") catch-body)) (let* ((_a$4768 n) (_a$4769 (keyword #f "catch-sym")) (_a$4770 (jolt-invoke (var-deref "clojure.core" "deref") catch-sym)) (_a$4771 (keyword #f "catch-body")) (_a$4772 (let* ((_a$4764 (var-deref "jolt.analyzer" "analyze-seq")) (_a$4765 ctx) (_a$4766 (jolt-invoke (var-deref "clojure.core" "deref") catch-body)) (_a$4767 (jolt-invoke (var-deref "jolt.analyzer" "add-locals") env (jolt-vector (jolt-invoke (var-deref "clojure.core" "deref") catch-sym))))) (jolt-invoke _a$4764 _a$4765 _a$4766 _a$4767)))) (jolt-assoc _a$4768 _a$4769 _a$4770 _a$4771 _a$4772)) n)) (n (if (jolt-truthy? (jolt-invoke (var-deref "clojure.core" "deref") finally-body)) (jolt-assoc n (keyword #f "finally") (jolt-invoke (var-deref "jolt.analyzer" "analyze-seq") ctx (jolt-invoke (var-deref "clojure.core" "deref") finally-body) env)) n))) n))))))) analyze-try))) + (def-var! "jolt.analyzer" "analyze-try" (letrec ((analyze-try (lambda (ctx items env) (let fnrec4768 ((ctx ctx) (items items) (env env)) (let* ((clauses (jolt-rest items)) (body (jolt-invoke (var-deref "clojure.core" "atom") (jolt-vector))) (catch-sym (jolt-invoke (var-deref "clojure.core" "atom") jolt-nil)) (catch-body (jolt-invoke (var-deref "clojure.core" "atom") jolt-nil)) (finally-body (jolt-invoke (var-deref "clojure.core" "atom") jolt-nil))) (begin (begin (jolt-count (jolt-map (lambda (c) (let fnrec4769 ((c c)) (begin (let* ((head (if (jolt-truthy? (jolt-invoke (var-deref "jolt.host" "form-list?") c)) (jolt-first (jolt-invoke (var-deref "clojure.core" "vec") (jolt-invoke (var-deref "jolt.host" "form-elements") c))) jolt-nil)) (hname (if (jolt-truthy? (let* ((and__13__auto head)) (if (jolt-truthy? and__13__auto) (jolt-invoke (var-deref "jolt.host" "form-sym?") head) and__13__auto))) (jolt-invoke (var-deref "jolt.host" "form-sym-name") head) jolt-nil))) (if (jolt= hname "catch") (let* ((cl (jolt-invoke (var-deref "clojure.core" "vec") (jolt-invoke (var-deref "jolt.host" "form-elements") c)))) (begin (if (jolt-truthy? (let* ((or__14__auto (< (jolt-count cl) 3))) (if (jolt-truthy? or__14__auto) or__14__auto (jolt-not (jolt-invoke (var-deref "jolt.host" "form-sym?") (jolt-nth cl 2)))))) (jolt-throw "Unable to parse catch clause; expected (catch class binding body*)") jolt-nil) (jolt-invoke (var-deref "clojure.core" "reset!") catch-sym (jolt-invoke (var-deref "jolt.host" "form-sym-name") (jolt-nth cl 2))) (jolt-invoke (var-deref "clojure.core" "reset!") catch-body (jolt-drop 3 cl)))) (if (jolt= hname "finally") (jolt-invoke (var-deref "clojure.core" "reset!") finally-body (jolt-rest (jolt-invoke (var-deref "clojure.core" "vec") (jolt-invoke (var-deref "jolt.host" "form-elements") c)))) (if (jolt-truthy? (keyword #f "else")) (jolt-invoke (var-deref "clojure.core" "swap!") body jolt-conj c) jolt-nil)))) jolt-nil))) clauses)) jolt-nil) (let* ((n (let* ((_o$4770 (keyword #f "op")) (_o$4771 (keyword #f "try")) (_o$4772 (keyword #f "body")) (_o$4773 (jolt-invoke (var-deref "jolt.analyzer" "analyze-seq") ctx (jolt-invoke (var-deref "clojure.core" "deref") body) env))) (jolt-hash-map _o$4770 _o$4771 _o$4772 _o$4773))) (n (if (jolt-truthy? (jolt-invoke (var-deref "clojure.core" "deref") catch-body)) (let* ((_a$4778 n) (_a$4779 (keyword #f "catch-sym")) (_a$4780 (jolt-invoke (var-deref "clojure.core" "deref") catch-sym)) (_a$4781 (keyword #f "catch-body")) (_a$4782 (let* ((_a$4774 (var-deref "jolt.analyzer" "analyze-seq")) (_a$4775 ctx) (_a$4776 (jolt-invoke (var-deref "clojure.core" "deref") catch-body)) (_a$4777 (jolt-invoke (var-deref "jolt.analyzer" "add-locals") env (jolt-vector (jolt-invoke (var-deref "clojure.core" "deref") catch-sym))))) (jolt-invoke _a$4774 _a$4775 _a$4776 _a$4777)))) (jolt-assoc _a$4778 _a$4779 _a$4780 _a$4781 _a$4782)) n)) (n (if (jolt-truthy? (jolt-invoke (var-deref "clojure.core" "deref") finally-body)) (jolt-assoc n (keyword #f "finally") (jolt-invoke (var-deref "jolt.analyzer" "analyze-seq") ctx (jolt-invoke (var-deref "clojure.core" "deref") finally-body) env)) n))) n))))))) analyze-try))) (guard (e (#t #f)) - (def-var! "jolt.analyzer" "analyze-letfn" (letrec ((analyze-letfn (lambda (ctx items env) (let fnrec4773 ((ctx ctx) (items items) (env env)) (let* ((specs (jolt-invoke (var-deref "clojure.core" "vec") (jolt-invoke (var-deref "jolt.host" "form-vec-items") (jolt-nth items 1)))) (names (jolt-invoke (var-deref "clojure.core" "mapv") (lambda (p__49_) (let fnrec4774 ((p__49_ p__49_)) (jolt-invoke (var-deref "jolt.host" "form-sym-name") (jolt-first (jolt-invoke (var-deref "clojure.core" "vec") (jolt-invoke (var-deref "jolt.host" "form-elements") p__49_)))))) specs)) (env* (jolt-invoke (var-deref "jolt.analyzer" "add-locals") env names)) (binds (jolt-invoke (var-deref "clojure.core" "mapv") (lambda (spec) (let fnrec4775 ((spec spec)) (let* ((cl (jolt-invoke (var-deref "clojure.core" "vec") (jolt-invoke (var-deref "jolt.host" "form-elements") spec)))) (let* ((_o$4776 (jolt-invoke (var-deref "jolt.host" "form-sym-name") (jolt-first cl))) (_o$4777 (jolt-invoke (var-deref "jolt.analyzer" "analyze") ctx (jolt-cons (jolt-invoke (var-deref "clojure.core" "symbol") "fn") cl) env*))) (jolt-vector _o$4776 _o$4777))))) specs))) (let* ((_o$4778 (keyword #f "op")) (_o$4779 (keyword #f "let")) (_o$4780 (keyword #f "letrec")) (_o$4781 #t) (_o$4782 (keyword #f "bindings")) (_o$4783 binds) (_o$4784 (keyword #f "body")) (_o$4785 (jolt-invoke (var-deref "jolt.analyzer" "analyze-seq") ctx (jolt-drop 2 items) env*))) (jolt-hash-map _o$4778 _o$4779 _o$4780 _o$4781 _o$4782 _o$4783 _o$4784 _o$4785))))))) analyze-letfn))) + (def-var! "jolt.analyzer" "analyze-letfn" (letrec ((analyze-letfn (lambda (ctx items env) (let fnrec4783 ((ctx ctx) (items items) (env env)) (let* ((specs (jolt-invoke (var-deref "clojure.core" "vec") (jolt-invoke (var-deref "jolt.host" "form-vec-items") (jolt-nth items 1)))) (names (jolt-invoke (var-deref "clojure.core" "mapv") (lambda (p__49_) (let fnrec4784 ((p__49_ p__49_)) (jolt-invoke (var-deref "jolt.host" "form-sym-name") (jolt-first (jolt-invoke (var-deref "clojure.core" "vec") (jolt-invoke (var-deref "jolt.host" "form-elements") p__49_)))))) specs)) (env* (jolt-invoke (var-deref "jolt.analyzer" "add-locals") env names)) (binds (jolt-invoke (var-deref "clojure.core" "mapv") (lambda (spec) (let fnrec4785 ((spec spec)) (let* ((cl (jolt-invoke (var-deref "clojure.core" "vec") (jolt-invoke (var-deref "jolt.host" "form-elements") spec)))) (let* ((_o$4786 (jolt-invoke (var-deref "jolt.host" "form-sym-name") (jolt-first cl))) (_o$4787 (jolt-invoke (var-deref "jolt.analyzer" "analyze") ctx (jolt-cons (jolt-invoke (var-deref "clojure.core" "symbol") "fn") cl) env*))) (jolt-vector _o$4786 _o$4787))))) specs))) (let* ((_o$4788 (keyword #f "op")) (_o$4789 (keyword #f "let")) (_o$4790 (keyword #f "letrec")) (_o$4791 #t) (_o$4792 (keyword #f "bindings")) (_o$4793 binds) (_o$4794 (keyword #f "body")) (_o$4795 (jolt-invoke (var-deref "jolt.analyzer" "analyze-seq") ctx (jolt-drop 2 items) env*))) (jolt-hash-map _o$4788 _o$4789 _o$4790 _o$4791 _o$4792 _o$4793 _o$4794 _o$4795))))))) analyze-letfn))) (guard (e (#t #f)) - (def-var! "jolt.analyzer" "field-head?" (letrec ((field-head? (lambda (nm) (let fnrec4786 ((nm nm)) (let* ((and__13__auto (> (jolt-count nm) 2))) (if (jolt-truthy? and__13__auto) (jolt= ".-" (jolt-invoke (var-deref "clojure.core" "subs") nm 0 2)) and__13__auto)))))) field-head?))) + (def-var! "jolt.analyzer" "field-head?" (letrec ((field-head? (lambda (nm) (let fnrec4796 ((nm nm)) (let* ((and__13__auto (> (jolt-count nm) 2))) (if (jolt-truthy? and__13__auto) (jolt= ".-" (jolt-invoke (var-deref "clojure.core" "subs") nm 0 2)) and__13__auto)))))) field-head?))) (guard (e (#t #f)) - (def-var! "jolt.analyzer" "analyze-def" (letrec ((analyze-def (lambda (ctx items env) (let fnrec4787 ((ctx ctx) (items items) (env env)) (let* ((name-sym (jolt-nth items 1))) (begin (if (jolt-not (jolt-invoke (var-deref "jolt.host" "form-sym?") name-sym)) (jolt-invoke (var-deref "jolt.analyzer" "uncompilable") "def name with map metadata") jolt-nil) (if (< (jolt-count items) 3) (let* ((nm (jolt-invoke (var-deref "jolt.host" "form-sym-name") name-sym)) (cur (jolt-invoke (var-deref "jolt.host" "compile-ns") ctx))) (begin (jolt-invoke (var-deref "jolt.host" "host-intern!") ctx cur nm) (let* ((_o$4788 (keyword #f "op")) (_o$4789 (keyword #f "def")) (_o$4790 (keyword #f "ns")) (_o$4791 cur) (_o$4792 (keyword #f "name")) (_o$4793 nm) (_o$4794 (keyword #f "no-init")) (_o$4795 #t)) (jolt-hash-map _o$4788 _o$4789 _o$4790 _o$4791 _o$4792 _o$4793 _o$4794 _o$4795)))) (let* ((nm (jolt-invoke (var-deref "jolt.host" "form-sym-name") name-sym)) (cur (jolt-invoke (var-deref "jolt.host" "compile-ns") ctx)) (has-doc (let* ((and__13__auto (> (jolt-count items) 3))) (if (jolt-truthy? and__13__auto) (jolt-invoke (var-deref "clojure.core" "string?") (jolt-nth items 2)) and__13__auto))) (val-form (jolt-nth items (if (jolt-truthy? has-doc) 3 2))) (base0 (let* ((or__14__auto (jolt-invoke (var-deref "jolt.host" "form-sym-meta") name-sym))) (if (jolt-truthy? or__14__auto) or__14__auto (jolt-hash-map)))) (tag (jolt-get base0 (keyword #f "tag"))) (tag-name (if (jolt-truthy? (jolt-invoke (var-deref "jolt.host" "form-sym?") tag)) (jolt-invoke (var-deref "jolt.host" "form-sym-name") tag) (if (jolt-truthy? (jolt-invoke (var-deref "clojure.core" "string?") tag)) tag (if (jolt-truthy? (keyword #f "else")) jolt-nil jolt-nil)))) (base-meta (if (jolt-truthy? tag-name) (let* ((c (jolt-invoke (var-deref "jolt.host" "resolve-class-hint") tag-name))) (if (jolt-truthy? c) (jolt-assoc base0 (keyword #f "tag") c) base0)) base0)) (node-meta (if (jolt-truthy? has-doc) (jolt-assoc base-meta (keyword #f "doc") (jolt-nth items 2)) base-meta))) (begin (jolt-invoke (var-deref "jolt.host" "host-intern!") ctx cur nm) (jolt-invoke (var-deref "jolt.ir" "def-node") cur nm (jolt-invoke (var-deref "jolt.analyzer" "analyze") ctx val-form env) node-meta)))))))))) analyze-def))) + (def-var! "jolt.analyzer" "analyze-def" (letrec ((analyze-def (lambda (ctx items env) (let fnrec4797 ((ctx ctx) (items items) (env env)) (let* ((name-sym (jolt-nth items 1))) (begin (if (jolt-not (jolt-invoke (var-deref "jolt.host" "form-sym?") name-sym)) (jolt-invoke (var-deref "jolt.analyzer" "uncompilable") "def name with map metadata") jolt-nil) (if (< (jolt-count items) 3) (let* ((nm (jolt-invoke (var-deref "jolt.host" "form-sym-name") name-sym)) (cur (jolt-invoke (var-deref "jolt.host" "compile-ns") ctx))) (begin (jolt-invoke (var-deref "jolt.host" "host-intern!") ctx cur nm) (let* ((_o$4798 (keyword #f "op")) (_o$4799 (keyword #f "def")) (_o$4800 (keyword #f "ns")) (_o$4801 cur) (_o$4802 (keyword #f "name")) (_o$4803 nm) (_o$4804 (keyword #f "no-init")) (_o$4805 #t)) (jolt-hash-map _o$4798 _o$4799 _o$4800 _o$4801 _o$4802 _o$4803 _o$4804 _o$4805)))) (let* ((nm (jolt-invoke (var-deref "jolt.host" "form-sym-name") name-sym)) (cur (jolt-invoke (var-deref "jolt.host" "compile-ns") ctx)) (has-doc (let* ((and__13__auto (> (jolt-count items) 3))) (if (jolt-truthy? and__13__auto) (jolt-invoke (var-deref "clojure.core" "string?") (jolt-nth items 2)) and__13__auto))) (val-form (jolt-nth items (if (jolt-truthy? has-doc) 3 2))) (base0 (let* ((or__14__auto (jolt-invoke (var-deref "jolt.host" "form-sym-meta") name-sym))) (if (jolt-truthy? or__14__auto) or__14__auto (jolt-hash-map)))) (tag (jolt-get base0 (keyword #f "tag"))) (tag-name (if (jolt-truthy? (jolt-invoke (var-deref "jolt.host" "form-sym?") tag)) (jolt-invoke (var-deref "jolt.host" "form-sym-name") tag) (if (jolt-truthy? (jolt-invoke (var-deref "clojure.core" "string?") tag)) tag (if (jolt-truthy? (keyword #f "else")) jolt-nil jolt-nil)))) (base-meta (if (jolt-truthy? tag-name) (let* ((c (jolt-invoke (var-deref "jolt.host" "resolve-class-hint") tag-name))) (if (jolt-truthy? c) (jolt-assoc base0 (keyword #f "tag") c) base0)) base0)) (node-meta (if (jolt-truthy? has-doc) (jolt-assoc base-meta (keyword #f "doc") (jolt-nth items 2)) base-meta))) (begin (jolt-invoke (var-deref "jolt.host" "host-intern!") ctx cur nm) (jolt-invoke (var-deref "jolt.ir" "def-node") cur nm (jolt-invoke (var-deref "jolt.analyzer" "analyze") ctx val-form env) node-meta)))))))))) analyze-def))) (guard (e (#t #f)) - (def-var! "jolt.analyzer" "analyze-set!" (letrec ((analyze-set! (lambda (ctx items env) (let fnrec4796 ((ctx ctx) (items items) (env env)) (let* ((target (jolt-nth items 1)) (val-node (jolt-invoke (var-deref "jolt.analyzer" "analyze") ctx (jolt-nth items 2) env)) (ti (if (jolt-truthy? (jolt-invoke (var-deref "jolt.host" "form-list?") target)) (jolt-invoke (var-deref "clojure.core" "vec") (jolt-invoke (var-deref "jolt.host" "form-elements") target)) jolt-nil)) (thead (if (jolt-truthy? (let* ((and__13__auto ti)) (if (jolt-truthy? and__13__auto) (let* ((and__13__auto (jolt-pos? (jolt-count ti)))) (if (jolt-truthy? and__13__auto) (jolt-invoke (var-deref "jolt.host" "form-sym?") (jolt-first ti)) and__13__auto)) and__13__auto))) (jolt-invoke (var-deref "jolt.host" "form-sym-name") (jolt-first ti)) jolt-nil))) (if (jolt-truthy? (let* ((and__13__auto thead)) (if (jolt-truthy? and__13__auto) (jolt-invoke (var-deref "jolt.analyzer" "field-head?") thead) and__13__auto))) (let* ((_o$4797 (keyword #f "op")) (_o$4798 (keyword #f "set-field")) (_o$4799 (keyword #f "obj")) (_o$4800 (jolt-invoke (var-deref "jolt.analyzer" "analyze") ctx (jolt-nth ti 1) env)) (_o$4801 (keyword #f "field")) (_o$4802 (jolt-invoke (var-deref "clojure.core" "subs") thead 2)) (_o$4803 (keyword #f "val")) (_o$4804 val-node)) (jolt-hash-map _o$4797 _o$4798 _o$4799 _o$4800 _o$4801 _o$4802 _o$4803 _o$4804)) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.host" "form-sym?") target)) (begin (if (jolt-truthy? (jolt-invoke (var-deref "jolt.analyzer" "local?") env (jolt-invoke (var-deref "jolt.host" "form-sym-name") target))) (jolt-invoke (var-deref "jolt.analyzer" "uncompilable") "set! of a local") jolt-nil) (let* ((r (jolt-invoke (var-deref "jolt.host" "resolve-global") ctx target))) (begin (if (jolt-not (jolt= (keyword #f "var") (jolt-get r (keyword #f "kind")))) (jolt-invoke (var-deref "jolt.analyzer" "uncompilable") "set! of a non-var") jolt-nil) (let* ((_o$4808 (keyword #f "op")) (_o$4809 (keyword #f "set-var")) (_o$4810 (keyword #f "the-var")) (_o$4811 (let* ((_a$4805 (var-deref "jolt.ir" "the-var")) (_a$4806 (jolt-get r (keyword #f "ns"))) (_a$4807 (jolt-get r (keyword #f "name")))) (jolt-invoke _a$4805 _a$4806 _a$4807))) (_o$4812 (keyword #f "val")) (_o$4813 val-node)) (jolt-hash-map _o$4808 _o$4809 _o$4810 _o$4811 _o$4812 _o$4813))))) (if (jolt-truthy? (keyword #f "else")) (jolt-invoke (var-deref "jolt.analyzer" "uncompilable") "set! of an unsupported target") jolt-nil)))))))) analyze-set!))) + (def-var! "jolt.analyzer" "analyze-set!" (letrec ((analyze-set! (lambda (ctx items env) (let fnrec4806 ((ctx ctx) (items items) (env env)) (let* ((target (jolt-nth items 1)) (val-node (jolt-invoke (var-deref "jolt.analyzer" "analyze") ctx (jolt-nth items 2) env)) (ti (if (jolt-truthy? (jolt-invoke (var-deref "jolt.host" "form-list?") target)) (jolt-invoke (var-deref "clojure.core" "vec") (jolt-invoke (var-deref "jolt.host" "form-elements") target)) jolt-nil)) (thead (if (jolt-truthy? (let* ((and__13__auto ti)) (if (jolt-truthy? and__13__auto) (let* ((and__13__auto (jolt-pos? (jolt-count ti)))) (if (jolt-truthy? and__13__auto) (jolt-invoke (var-deref "jolt.host" "form-sym?") (jolt-first ti)) and__13__auto)) and__13__auto))) (jolt-invoke (var-deref "jolt.host" "form-sym-name") (jolt-first ti)) jolt-nil))) (if (jolt-truthy? (let* ((and__13__auto thead)) (if (jolt-truthy? and__13__auto) (jolt-invoke (var-deref "jolt.analyzer" "field-head?") thead) and__13__auto))) (let* ((_o$4807 (keyword #f "op")) (_o$4808 (keyword #f "set-field")) (_o$4809 (keyword #f "obj")) (_o$4810 (jolt-invoke (var-deref "jolt.analyzer" "analyze") ctx (jolt-nth ti 1) env)) (_o$4811 (keyword #f "field")) (_o$4812 (jolt-invoke (var-deref "clojure.core" "subs") thead 2)) (_o$4813 (keyword #f "val")) (_o$4814 val-node)) (jolt-hash-map _o$4807 _o$4808 _o$4809 _o$4810 _o$4811 _o$4812 _o$4813 _o$4814)) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.host" "form-sym?") target)) (begin (if (jolt-truthy? (jolt-invoke (var-deref "jolt.analyzer" "local?") env (jolt-invoke (var-deref "jolt.host" "form-sym-name") target))) (jolt-invoke (var-deref "jolt.analyzer" "uncompilable") "set! of a local") jolt-nil) (let* ((r (jolt-invoke (var-deref "jolt.host" "resolve-global") ctx target))) (begin (if (jolt-not (jolt= (keyword #f "var") (jolt-get r (keyword #f "kind")))) (jolt-invoke (var-deref "jolt.analyzer" "uncompilable") "set! of a non-var") jolt-nil) (let* ((_o$4818 (keyword #f "op")) (_o$4819 (keyword #f "set-var")) (_o$4820 (keyword #f "the-var")) (_o$4821 (let* ((_a$4815 (var-deref "jolt.ir" "the-var")) (_a$4816 (jolt-get r (keyword #f "ns"))) (_a$4817 (jolt-get r (keyword #f "name")))) (jolt-invoke _a$4815 _a$4816 _a$4817))) (_o$4822 (keyword #f "val")) (_o$4823 val-node)) (jolt-hash-map _o$4818 _o$4819 _o$4820 _o$4821 _o$4822 _o$4823))))) (if (jolt-truthy? (keyword #f "else")) (jolt-invoke (var-deref "jolt.analyzer" "uncompilable") "set! of an unsupported target") jolt-nil)))))))) analyze-set!))) (guard (e (#t #f)) - (def-var! "jolt.analyzer" "analyze-special" (letrec ((analyze-special (lambda (ctx op items env) (let fnrec4814 ((ctx ctx) (op op) (items items) (env env)) (let* ((G__44 op)) (if (jolt= G__44 "quote") (jolt-invoke (var-deref "jolt.ir" "quote-node") (jolt-invoke (var-deref "clojure.core" "second") items)) (if (jolt= G__44 "if") (begin (if (jolt-truthy? (let* ((or__14__auto (< (jolt-count items) 3))) (if (jolt-truthy? or__14__auto) or__14__auto (> (jolt-count items) 4)))) (jolt-throw (jolt-invoke (var-deref "clojure.core" "str") "Wrong number of args (" (jolt-dec (jolt-count items)) ") passed to: if")) jolt-nil) (let* ((_a$4815 (var-deref "jolt.ir" "if-node")) (_a$4816 (jolt-invoke (var-deref "jolt.analyzer" "analyze") ctx (jolt-nth items 1) env)) (_a$4817 (jolt-invoke (var-deref "jolt.analyzer" "analyze") ctx (jolt-nth items 2) env)) (_a$4818 (if (> (jolt-count items) 3) (jolt-invoke (var-deref "jolt.analyzer" "analyze") ctx (jolt-nth items 3) env) (jolt-invoke (var-deref "jolt.ir" "const") jolt-nil)))) (jolt-invoke _a$4815 _a$4816 _a$4817 _a$4818))) (if (jolt= G__44 "do") (jolt-invoke (var-deref "jolt.analyzer" "analyze-seq") ctx (jolt-rest items) env) (if (jolt= G__44 "throw") (jolt-invoke (var-deref "jolt.ir" "throw-node") (jolt-invoke (var-deref "jolt.analyzer" "analyze") ctx (jolt-nth items 1) env)) (if (jolt= G__44 "def") (jolt-invoke (var-deref "jolt.analyzer" "analyze-def") ctx items env) (if (jolt= G__44 "let*") (let* ((bvec (jolt-invoke (var-deref "clojure.core" "vec") (jolt-invoke (var-deref "jolt.host" "form-vec-items") (jolt-nth items 1)))) (r (jolt-invoke (var-deref "jolt.analyzer" "analyze-bindings") ctx bvec env))) (let* ((_a$4823 (var-deref "jolt.ir" "let-node")) (_a$4824 (jolt-first r)) (_a$4825 (let* ((_a$4819 (var-deref "jolt.analyzer" "analyze-seq")) (_a$4820 ctx) (_a$4821 (jolt-drop 2 items)) (_a$4822 (jolt-invoke (var-deref "clojure.core" "second") r))) (jolt-invoke _a$4819 _a$4820 _a$4821 _a$4822)))) (jolt-invoke _a$4823 _a$4824 _a$4825))) (if (jolt= G__44 "loop*") (let* ((bvec (jolt-invoke (var-deref "clojure.core" "vec") (jolt-invoke (var-deref "jolt.host" "form-vec-items") (jolt-nth items 1)))) (rname (jolt-invoke (var-deref "jolt.analyzer" "gen-name") "loop")) (r (jolt-invoke (var-deref "jolt.analyzer" "analyze-bindings") ctx bvec env)) (env** (jolt-invoke (var-deref "jolt.analyzer" "with-recur") (jolt-invoke (var-deref "clojure.core" "second") r) rname))) (let* ((_o$4826 (keyword #f "op")) (_o$4827 (keyword #f "loop")) (_o$4828 (keyword #f "recur-name")) (_o$4829 rname) (_o$4830 (keyword #f "bindings")) (_o$4831 (jolt-first r)) (_o$4832 (keyword #f "body")) (_o$4833 (jolt-invoke (var-deref "jolt.analyzer" "analyze-seq") ctx (jolt-drop 2 items) env**))) (jolt-hash-map _o$4826 _o$4827 _o$4828 _o$4829 _o$4830 _o$4831 _o$4832 _o$4833))) (if (jolt= G__44 "recur") (let* ((rt (jolt-get env (keyword #f "recur")))) (begin (if (jolt-not rt) (jolt-invoke (var-deref "jolt.analyzer" "uncompilable") "recur outside loop/fn") jolt-nil) (let* ((_o$4838 (keyword #f "op")) (_o$4839 (keyword #f "recur")) (_o$4840 (keyword #f "recur-name")) (_o$4841 rt) (_o$4842 (keyword #f "args")) (_o$4843 (let* ((_a$4835 (var-deref "clojure.core" "mapv")) (_a$4836 (lambda (p__50_) (let fnrec4834 ((p__50_ p__50_)) (jolt-invoke (var-deref "jolt.analyzer" "analyze") ctx p__50_ env)))) (_a$4837 (jolt-rest items))) (jolt-invoke _a$4835 _a$4836 _a$4837)))) (jolt-hash-map _o$4838 _o$4839 _o$4840 _o$4841 _o$4842 _o$4843)))) (if (jolt= G__44 "try") (jolt-invoke (var-deref "jolt.analyzer" "analyze-try") ctx items env) (if (jolt= G__44 "letfn") (jolt-invoke (var-deref "jolt.analyzer" "analyze-letfn") ctx items env) (if (jolt= G__44 "fn*") (jolt-invoke (var-deref "jolt.analyzer" "analyze-fn") ctx items env) (if (jolt= G__44 "syntax-quote") (jolt-invoke (var-deref "jolt.analyzer" "analyze") ctx (jolt-invoke (var-deref "jolt.host" "form-syntax-quote-lower") ctx (jolt-invoke (var-deref "clojure.core" "second") items)) env) (if (jolt= G__44 "var") (let* ((sym (jolt-invoke (var-deref "clojure.core" "second") items)) (r (jolt-invoke (var-deref "jolt.host" "resolve-global") ctx sym))) (if (jolt= (keyword #f "var") (jolt-get r (keyword #f "kind"))) (let* ((_a$4844 (var-deref "jolt.ir" "the-var")) (_a$4845 (jolt-get r (keyword #f "ns"))) (_a$4846 (jolt-get r (keyword #f "name")))) (jolt-invoke _a$4844 _a$4845 _a$4846)) (jolt-invoke (var-deref "jolt.analyzer" "uncompilable") (jolt-invoke (var-deref "clojure.core" "str") "var of non-var " (jolt-invoke (var-deref "jolt.host" "form-sym-name") sym))))) (if (jolt= G__44 "defmacro") (let* ((name-sym (jolt-nth items 1)) (nm (jolt-invoke (var-deref "jolt.host" "form-sym-name") name-sym)) (cur (jolt-invoke (var-deref "jolt.host" "compile-ns") ctx)) (after (jolt-drop 2 items)) (after (if (jolt-truthy? (jolt-invoke (var-deref "clojure.core" "string?") (jolt-first after))) (jolt-rest after) after)) (after (if (jolt-truthy? (jolt-invoke (var-deref "jolt.host" "form-map?") (jolt-first after))) (jolt-rest after) after)) (fn-form (jolt-cons (jolt-invoke (var-deref "clojure.core" "symbol") "fn") after))) (begin (jolt-invoke (var-deref "jolt.host" "host-intern!") ctx cur nm) (let* ((_o$4847 (keyword #f "op")) (_o$4848 (keyword #f "defmacro")) (_o$4849 (keyword #f "ns")) (_o$4850 cur) (_o$4851 (keyword #f "name")) (_o$4852 nm) (_o$4853 (keyword #f "fn")) (_o$4854 (jolt-invoke (var-deref "jolt.analyzer" "analyze") ctx fn-form env))) (jolt-hash-map _o$4847 _o$4848 _o$4849 _o$4850 _o$4851 _o$4852 _o$4853 _o$4854)))) (if (jolt= G__44 "set!") (jolt-invoke (var-deref "jolt.analyzer" "analyze-set!") ctx items env) (jolt-invoke (var-deref "jolt.analyzer" "uncompilable") (jolt-invoke (var-deref "clojure.core" "str") "special form " op)))))))))))))))))))))) analyze-special))) + (def-var! "jolt.analyzer" "analyze-special" (letrec ((analyze-special (lambda (ctx op items env) (let fnrec4824 ((ctx ctx) (op op) (items items) (env env)) (let* ((G__44 op)) (if (jolt= G__44 "quote") (jolt-invoke (var-deref "jolt.ir" "quote-node") (jolt-invoke (var-deref "clojure.core" "second") items)) (if (jolt= G__44 "if") (begin (if (jolt-truthy? (let* ((or__14__auto (< (jolt-count items) 3))) (if (jolt-truthy? or__14__auto) or__14__auto (> (jolt-count items) 4)))) (jolt-throw (jolt-invoke (var-deref "clojure.core" "str") "Wrong number of args (" (jolt-dec (jolt-count items)) ") passed to: if")) jolt-nil) (let* ((_a$4825 (var-deref "jolt.ir" "if-node")) (_a$4826 (jolt-invoke (var-deref "jolt.analyzer" "analyze") ctx (jolt-nth items 1) env)) (_a$4827 (jolt-invoke (var-deref "jolt.analyzer" "analyze") ctx (jolt-nth items 2) env)) (_a$4828 (if (> (jolt-count items) 3) (jolt-invoke (var-deref "jolt.analyzer" "analyze") ctx (jolt-nth items 3) env) (jolt-invoke (var-deref "jolt.ir" "const") jolt-nil)))) (jolt-invoke _a$4825 _a$4826 _a$4827 _a$4828))) (if (jolt= G__44 "do") (jolt-invoke (var-deref "jolt.analyzer" "analyze-seq") ctx (jolt-rest items) env) (if (jolt= G__44 "throw") (jolt-invoke (var-deref "jolt.ir" "throw-node") (jolt-invoke (var-deref "jolt.analyzer" "analyze") ctx (jolt-nth items 1) env)) (if (jolt= G__44 "def") (jolt-invoke (var-deref "jolt.analyzer" "analyze-def") ctx items env) (if (jolt= G__44 "let*") (let* ((bvec (jolt-invoke (var-deref "clojure.core" "vec") (jolt-invoke (var-deref "jolt.host" "form-vec-items") (jolt-nth items 1)))) (r (jolt-invoke (var-deref "jolt.analyzer" "analyze-bindings") ctx bvec env))) (let* ((_a$4833 (var-deref "jolt.ir" "let-node")) (_a$4834 (jolt-first r)) (_a$4835 (let* ((_a$4829 (var-deref "jolt.analyzer" "analyze-seq")) (_a$4830 ctx) (_a$4831 (jolt-drop 2 items)) (_a$4832 (jolt-invoke (var-deref "clojure.core" "second") r))) (jolt-invoke _a$4829 _a$4830 _a$4831 _a$4832)))) (jolt-invoke _a$4833 _a$4834 _a$4835))) (if (jolt= G__44 "loop*") (let* ((bvec (jolt-invoke (var-deref "clojure.core" "vec") (jolt-invoke (var-deref "jolt.host" "form-vec-items") (jolt-nth items 1)))) (rname (jolt-invoke (var-deref "jolt.analyzer" "gen-name") "loop")) (r (jolt-invoke (var-deref "jolt.analyzer" "analyze-bindings") ctx bvec env)) (env** (jolt-invoke (var-deref "jolt.analyzer" "with-recur") (jolt-invoke (var-deref "clojure.core" "second") r) rname))) (let* ((_o$4836 (keyword #f "op")) (_o$4837 (keyword #f "loop")) (_o$4838 (keyword #f "recur-name")) (_o$4839 rname) (_o$4840 (keyword #f "bindings")) (_o$4841 (jolt-first r)) (_o$4842 (keyword #f "body")) (_o$4843 (jolt-invoke (var-deref "jolt.analyzer" "analyze-seq") ctx (jolt-drop 2 items) env**))) (jolt-hash-map _o$4836 _o$4837 _o$4838 _o$4839 _o$4840 _o$4841 _o$4842 _o$4843))) (if (jolt= G__44 "recur") (let* ((rt (jolt-get env (keyword #f "recur")))) (begin (if (jolt-not rt) (jolt-invoke (var-deref "jolt.analyzer" "uncompilable") "recur outside loop/fn") jolt-nil) (let* ((_o$4848 (keyword #f "op")) (_o$4849 (keyword #f "recur")) (_o$4850 (keyword #f "recur-name")) (_o$4851 rt) (_o$4852 (keyword #f "args")) (_o$4853 (let* ((_a$4845 (var-deref "clojure.core" "mapv")) (_a$4846 (lambda (p__50_) (let fnrec4844 ((p__50_ p__50_)) (jolt-invoke (var-deref "jolt.analyzer" "analyze") ctx p__50_ env)))) (_a$4847 (jolt-rest items))) (jolt-invoke _a$4845 _a$4846 _a$4847)))) (jolt-hash-map _o$4848 _o$4849 _o$4850 _o$4851 _o$4852 _o$4853)))) (if (jolt= G__44 "try") (jolt-invoke (var-deref "jolt.analyzer" "analyze-try") ctx items env) (if (jolt= G__44 "letfn") (jolt-invoke (var-deref "jolt.analyzer" "analyze-letfn") ctx items env) (if (jolt= G__44 "fn*") (jolt-invoke (var-deref "jolt.analyzer" "analyze-fn") ctx items env) (if (jolt= G__44 "syntax-quote") (jolt-invoke (var-deref "jolt.analyzer" "analyze") ctx (jolt-invoke (var-deref "jolt.host" "form-syntax-quote-lower") ctx (jolt-invoke (var-deref "clojure.core" "second") items)) env) (if (jolt= G__44 "var") (let* ((sym (jolt-invoke (var-deref "clojure.core" "second") items)) (r (jolt-invoke (var-deref "jolt.host" "resolve-global") ctx sym))) (if (jolt= (keyword #f "var") (jolt-get r (keyword #f "kind"))) (let* ((_a$4854 (var-deref "jolt.ir" "the-var")) (_a$4855 (jolt-get r (keyword #f "ns"))) (_a$4856 (jolt-get r (keyword #f "name")))) (jolt-invoke _a$4854 _a$4855 _a$4856)) (jolt-invoke (var-deref "jolt.analyzer" "uncompilable") (jolt-invoke (var-deref "clojure.core" "str") "var of non-var " (jolt-invoke (var-deref "jolt.host" "form-sym-name") sym))))) (if (jolt= G__44 "defmacro") (let* ((name-sym (jolt-nth items 1)) (nm (jolt-invoke (var-deref "jolt.host" "form-sym-name") name-sym)) (cur (jolt-invoke (var-deref "jolt.host" "compile-ns") ctx)) (after (jolt-drop 2 items)) (after (if (jolt-truthy? (jolt-invoke (var-deref "clojure.core" "string?") (jolt-first after))) (jolt-rest after) after)) (after (if (jolt-truthy? (jolt-invoke (var-deref "jolt.host" "form-map?") (jolt-first after))) (jolt-rest after) after)) (fn-form (jolt-cons (jolt-invoke (var-deref "clojure.core" "symbol") "fn") after))) (begin (jolt-invoke (var-deref "jolt.host" "host-intern!") ctx cur nm) (let* ((_o$4857 (keyword #f "op")) (_o$4858 (keyword #f "defmacro")) (_o$4859 (keyword #f "ns")) (_o$4860 cur) (_o$4861 (keyword #f "name")) (_o$4862 nm) (_o$4863 (keyword #f "fn")) (_o$4864 (jolt-invoke (var-deref "jolt.analyzer" "analyze") ctx fn-form env))) (jolt-hash-map _o$4857 _o$4858 _o$4859 _o$4860 _o$4861 _o$4862 _o$4863 _o$4864)))) (if (jolt= G__44 "set!") (jolt-invoke (var-deref "jolt.analyzer" "analyze-set!") ctx items env) (jolt-invoke (var-deref "jolt.analyzer" "uncompilable") (jolt-invoke (var-deref "clojure.core" "str") "special form " op)))))))))))))))))))))) analyze-special))) (guard (e (#t #f)) - (def-var! "jolt.analyzer" "method-head?" (letrec ((method-head? (lambda (nm) (let fnrec4855 ((nm nm)) (let* ((and__13__auto (> (jolt-count nm) 1))) (if (jolt-truthy? and__13__auto) (let* ((and__13__auto (jolt= "." (jolt-invoke (var-deref "clojure.core" "subs") nm 0 1)))) (if (jolt-truthy? and__13__auto) (let* ((and__13__auto (jolt-not (jolt= "-" (jolt-invoke (var-deref "clojure.core" "subs") nm 1 2))))) (if (jolt-truthy? and__13__auto) (jolt-not (jolt= "." (jolt-invoke (var-deref "clojure.core" "subs") nm 1 2))) and__13__auto)) and__13__auto)) and__13__auto)))))) method-head?))) + (def-var! "jolt.analyzer" "method-head?" (letrec ((method-head? (lambda (nm) (let fnrec4865 ((nm nm)) (let* ((and__13__auto (> (jolt-count nm) 1))) (if (jolt-truthy? and__13__auto) (let* ((and__13__auto (jolt= "." (jolt-invoke (var-deref "clojure.core" "subs") nm 0 1)))) (if (jolt-truthy? and__13__auto) (let* ((and__13__auto (jolt-not (jolt= "-" (jolt-invoke (var-deref "clojure.core" "subs") nm 1 2))))) (if (jolt-truthy? and__13__auto) (jolt-not (jolt= "." (jolt-invoke (var-deref "clojure.core" "subs") nm 1 2))) and__13__auto)) and__13__auto)) and__13__auto)))))) method-head?))) (guard (e (#t #f)) - (def-var! "jolt.analyzer" "analyze-host-call" (letrec ((analyze-host-call (lambda (ctx hname items env) (let fnrec4856 ((ctx ctx) (hname hname) (items items) (env env)) (begin (if (< (jolt-count items) 2) (jolt-throw (jolt-invoke (var-deref "clojure.core" "str") "Malformed member expression, expecting (.method target ...): " hname)) jolt-nil) (let* ((_o$4861 (keyword #f "op")) (_o$4862 (keyword #f "host-call")) (_o$4863 (keyword #f "method")) (_o$4864 (jolt-invoke (var-deref "clojure.core" "subs") hname 1)) (_o$4865 (keyword #f "target")) (_o$4866 (jolt-invoke (var-deref "jolt.analyzer" "analyze") ctx (jolt-nth items 1) env)) (_o$4867 (keyword #f "args")) (_o$4868 (let* ((_a$4858 (var-deref "clojure.core" "mapv")) (_a$4859 (lambda (p__51_) (let fnrec4857 ((p__51_ p__51_)) (jolt-invoke (var-deref "jolt.analyzer" "analyze") ctx p__51_ env)))) (_a$4860 (jolt-drop 2 items))) (jolt-invoke _a$4858 _a$4859 _a$4860)))) (jolt-hash-map _o$4861 _o$4862 _o$4863 _o$4864 _o$4865 _o$4866 _o$4867 _o$4868))))))) analyze-host-call))) + (def-var! "jolt.analyzer" "analyze-host-call" (letrec ((analyze-host-call (lambda (ctx hname items env) (let fnrec4866 ((ctx ctx) (hname hname) (items items) (env env)) (begin (if (< (jolt-count items) 2) (jolt-throw (jolt-invoke (var-deref "clojure.core" "str") "Malformed member expression, expecting (.method target ...): " hname)) jolt-nil) (let* ((_o$4871 (keyword #f "op")) (_o$4872 (keyword #f "host-call")) (_o$4873 (keyword #f "method")) (_o$4874 (jolt-invoke (var-deref "clojure.core" "subs") hname 1)) (_o$4875 (keyword #f "target")) (_o$4876 (jolt-invoke (var-deref "jolt.analyzer" "analyze") ctx (jolt-nth items 1) env)) (_o$4877 (keyword #f "args")) (_o$4878 (let* ((_a$4868 (var-deref "clojure.core" "mapv")) (_a$4869 (lambda (p__51_) (let fnrec4867 ((p__51_ p__51_)) (jolt-invoke (var-deref "jolt.analyzer" "analyze") ctx p__51_ env)))) (_a$4870 (jolt-drop 2 items))) (jolt-invoke _a$4868 _a$4869 _a$4870)))) (jolt-hash-map _o$4871 _o$4872 _o$4873 _o$4874 _o$4875 _o$4876 _o$4877 _o$4878))))))) analyze-host-call))) (guard (e (#t #f)) - (def-var! "jolt.analyzer" "ctor-head?" (letrec ((ctor-head? (lambda (nm) (let fnrec4869 ((nm nm)) (let* ((and__13__auto (> (jolt-count nm) 1))) (if (jolt-truthy? and__13__auto) (let* ((and__13__auto (jolt= "." (let* ((_a$4870 (var-deref "clojure.core" "subs")) (_a$4871 nm) (_a$4872 (jolt-dec (jolt-count nm))) (_a$4873 (jolt-count nm))) (jolt-invoke _a$4870 _a$4871 _a$4872 _a$4873))))) (if (jolt-truthy? and__13__auto) (jolt-not (jolt= "." (jolt-invoke (var-deref "clojure.core" "subs") nm 0 1))) and__13__auto)) and__13__auto)))))) ctor-head?))) + (def-var! "jolt.analyzer" "ctor-head?" (letrec ((ctor-head? (lambda (nm) (let fnrec4879 ((nm nm)) (let* ((and__13__auto (> (jolt-count nm) 1))) (if (jolt-truthy? and__13__auto) (let* ((and__13__auto (jolt= "." (let* ((_a$4880 (var-deref "clojure.core" "subs")) (_a$4881 nm) (_a$4882 (jolt-dec (jolt-count nm))) (_a$4883 (jolt-count nm))) (jolt-invoke _a$4880 _a$4881 _a$4882 _a$4883))))) (if (jolt-truthy? and__13__auto) (jolt-not (jolt= "." (jolt-invoke (var-deref "clojure.core" "subs") nm 0 1))) and__13__auto)) and__13__auto)))))) ctor-head?))) (guard (e (#t #f)) - (def-var! "jolt.analyzer" "analyze-ctor" (letrec ((analyze-ctor (lambda (ctx class args env) (let fnrec4874 ((ctx ctx) (class class) (args args) (env env)) (jolt-invoke (var-deref "jolt.ir" "host-new") class (jolt-invoke (var-deref "clojure.core" "mapv") (lambda (p__52_) (let fnrec4875 ((p__52_ p__52_)) (jolt-invoke (var-deref "jolt.analyzer" "analyze") ctx p__52_ env))) args)))))) analyze-ctor))) + (def-var! "jolt.analyzer" "analyze-ctor" (letrec ((analyze-ctor (lambda (ctx class args env) (let fnrec4884 ((ctx ctx) (class class) (args args) (env env)) (jolt-invoke (var-deref "jolt.ir" "host-new") class (jolt-invoke (var-deref "clojure.core" "mapv") (lambda (p__52_) (let fnrec4885 ((p__52_ p__52_)) (jolt-invoke (var-deref "jolt.analyzer" "analyze") ctx p__52_ env))) args)))))) analyze-ctor))) (guard (e (#t #f)) - (def-var! "jolt.analyzer" "analyze-ffi-fn" (letrec ((analyze-ffi-fn (lambda (ctx items env) (let fnrec4876 ((ctx ctx) (items items) (env env)) (begin (if (jolt-not (<= 4 (jolt-count items) 5)) (jolt-throw (jolt-invoke (var-deref "clojure.core" "str") "jolt.ffi/foreign-fn expects (foreign-fn \"sym\" [argtypes] rettype [:blocking])")) jolt-nil) (let* ((_o$4877 (keyword #f "op")) (_o$4878 (keyword #f "ffi-fn")) (_o$4879 (keyword #f "csym")) (_o$4880 (jolt-nth items 1)) (_o$4881 (keyword #f "argtypes")) (_o$4882 (jolt-invoke (var-deref "clojure.core" "mapv") (var-deref "clojure.core" "name") (jolt-invoke (var-deref "jolt.host" "form-vec-items") (jolt-nth items 2)))) (_o$4883 (keyword #f "rettype")) (_o$4884 (jolt-invoke (var-deref "clojure.core" "name") (jolt-nth items 3))) (_o$4885 (keyword #f "blocking")) (_o$4886 (let* ((and__13__auto (jolt= 5 (jolt-count items)))) (if (jolt-truthy? and__13__auto) (jolt= "blocking" (jolt-invoke (var-deref "clojure.core" "name") (jolt-nth items 4))) and__13__auto)))) (jolt-hash-map _o$4877 _o$4878 _o$4879 _o$4880 _o$4881 _o$4882 _o$4883 _o$4884 _o$4885 _o$4886))))))) analyze-ffi-fn))) + (def-var! "jolt.analyzer" "analyze-ffi-fn" (letrec ((analyze-ffi-fn (lambda (ctx items env) (let fnrec4886 ((ctx ctx) (items items) (env env)) (begin (if (jolt-not (<= 4 (jolt-count items) 5)) (jolt-throw (jolt-invoke (var-deref "clojure.core" "str") "jolt.ffi/foreign-fn expects (foreign-fn \"sym\" [argtypes] rettype [:blocking])")) jolt-nil) (let* ((_o$4887 (keyword #f "op")) (_o$4888 (keyword #f "ffi-fn")) (_o$4889 (keyword #f "csym")) (_o$4890 (jolt-nth items 1)) (_o$4891 (keyword #f "argtypes")) (_o$4892 (jolt-invoke (var-deref "clojure.core" "mapv") (var-deref "clojure.core" "name") (jolt-invoke (var-deref "jolt.host" "form-vec-items") (jolt-nth items 2)))) (_o$4893 (keyword #f "rettype")) (_o$4894 (jolt-invoke (var-deref "clojure.core" "name") (jolt-nth items 3))) (_o$4895 (keyword #f "blocking")) (_o$4896 (let* ((and__13__auto (jolt= 5 (jolt-count items)))) (if (jolt-truthy? and__13__auto) (jolt= "blocking" (jolt-invoke (var-deref "clojure.core" "name") (jolt-nth items 4))) and__13__auto)))) (jolt-hash-map _o$4887 _o$4888 _o$4889 _o$4890 _o$4891 _o$4892 _o$4893 _o$4894 _o$4895 _o$4896))))))) analyze-ffi-fn))) (guard (e (#t #f)) - (def-var! "jolt.analyzer" "analyze-dot" (letrec ((analyze-dot (lambda (ctx items env) (let fnrec4887 ((ctx ctx) (items items) (env env)) (begin (if (< (jolt-count items) 3) (jolt-throw (jolt-invoke (var-deref "clojure.core" "str") "Malformed (. target member ...) form")) jolt-nil) (let* ((member (jolt-nth items 2))) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.host" "form-sym?") member)) (let* ((_o$4892 (keyword #f "op")) (_o$4893 (keyword #f "host-call")) (_o$4894 (keyword #f "method")) (_o$4895 (jolt-invoke (var-deref "jolt.host" "form-sym-name") member)) (_o$4896 (keyword #f "target")) (_o$4897 (jolt-invoke (var-deref "jolt.analyzer" "analyze") ctx (jolt-nth items 1) env)) (_o$4898 (keyword #f "args")) (_o$4899 (let* ((_a$4889 (var-deref "clojure.core" "mapv")) (_a$4890 (lambda (p__53_) (let fnrec4888 ((p__53_ p__53_)) (jolt-invoke (var-deref "jolt.analyzer" "analyze") ctx p__53_ env)))) (_a$4891 (jolt-drop 3 items))) (jolt-invoke _a$4889 _a$4890 _a$4891)))) (jolt-hash-map _o$4892 _o$4893 _o$4894 _o$4895 _o$4896 _o$4897 _o$4898 _o$4899)) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.host" "form-keyword?") member)) (let* ((_a$4900 (var-deref "jolt.ir" "invoke")) (_a$4901 (jolt-invoke (var-deref "jolt.analyzer" "analyze") ctx member env)) (_a$4902 (jolt-vector (jolt-invoke (var-deref "jolt.analyzer" "analyze") ctx (jolt-nth items 1) env)))) (jolt-invoke _a$4900 _a$4901 _a$4902)) (if (jolt-truthy? (keyword #f "else")) (jolt-invoke (var-deref "jolt.analyzer" "uncompilable") "special form . (non-symbol member)") jolt-nil))))))))) analyze-dot))) + (def-var! "jolt.analyzer" "analyze-ffi-callable" (letrec ((analyze-ffi-callable (lambda (ctx items env) (let fnrec4897 ((ctx ctx) (items items) (env env)) (begin (if (jolt-not (<= 4 (jolt-count items) 5)) (jolt-throw (jolt-invoke (var-deref "clojure.core" "str") "jolt.ffi/foreign-callable expects (foreign-callable f [argtypes] rettype [:collect-safe])")) jolt-nil) (let* ((_o$4898 (keyword #f "op")) (_o$4899 (keyword #f "ffi-callable")) (_o$4900 (keyword #f "fn")) (_o$4901 (jolt-invoke (var-deref "jolt.analyzer" "analyze") ctx (jolt-nth items 1) env)) (_o$4902 (keyword #f "argtypes")) (_o$4903 (jolt-invoke (var-deref "clojure.core" "mapv") (var-deref "clojure.core" "name") (jolt-invoke (var-deref "jolt.host" "form-vec-items") (jolt-nth items 2)))) (_o$4904 (keyword #f "rettype")) (_o$4905 (jolt-invoke (var-deref "clojure.core" "name") (jolt-nth items 3))) (_o$4906 (keyword #f "collect-safe")) (_o$4907 (let* ((and__13__auto (jolt= 5 (jolt-count items)))) (if (jolt-truthy? and__13__auto) (jolt= "collect-safe" (jolt-invoke (var-deref "clojure.core" "name") (jolt-nth items 4))) and__13__auto)))) (jolt-hash-map _o$4898 _o$4899 _o$4900 _o$4901 _o$4902 _o$4903 _o$4904 _o$4905 _o$4906 _o$4907))))))) analyze-ffi-callable))) (guard (e (#t #f)) - (def-var! "jolt.analyzer" "analyze-field" (letrec ((analyze-field (lambda (ctx hname items env) (let fnrec4903 ((ctx ctx) (hname hname) (items items) (env env)) (begin (if (< (jolt-count items) 2) (jolt-throw (jolt-invoke (var-deref "clojure.core" "str") "Malformed (.-field target) form")) jolt-nil) (let* ((_o$4904 (keyword #f "op")) (_o$4905 (keyword #f "host-call")) (_o$4906 (keyword #f "method")) (_o$4907 (jolt-invoke (var-deref "clojure.core" "subs") hname 1)) (_o$4908 (keyword #f "target")) (_o$4909 (jolt-invoke (var-deref "jolt.analyzer" "analyze") ctx (jolt-nth items 1) env)) (_o$4910 (keyword #f "args")) (_o$4911 (jolt-vector))) (jolt-hash-map _o$4904 _o$4905 _o$4906 _o$4907 _o$4908 _o$4909 _o$4910 _o$4911))))))) analyze-field))) + (def-var! "jolt.analyzer" "analyze-dot" (letrec ((analyze-dot (lambda (ctx items env) (let fnrec4908 ((ctx ctx) (items items) (env env)) (begin (if (< (jolt-count items) 3) (jolt-throw (jolt-invoke (var-deref "clojure.core" "str") "Malformed (. target member ...) form")) jolt-nil) (let* ((member (jolt-nth items 2))) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.host" "form-sym?") member)) (let* ((_o$4913 (keyword #f "op")) (_o$4914 (keyword #f "host-call")) (_o$4915 (keyword #f "method")) (_o$4916 (jolt-invoke (var-deref "jolt.host" "form-sym-name") member)) (_o$4917 (keyword #f "target")) (_o$4918 (jolt-invoke (var-deref "jolt.analyzer" "analyze") ctx (jolt-nth items 1) env)) (_o$4919 (keyword #f "args")) (_o$4920 (let* ((_a$4910 (var-deref "clojure.core" "mapv")) (_a$4911 (lambda (p__53_) (let fnrec4909 ((p__53_ p__53_)) (jolt-invoke (var-deref "jolt.analyzer" "analyze") ctx p__53_ env)))) (_a$4912 (jolt-drop 3 items))) (jolt-invoke _a$4910 _a$4911 _a$4912)))) (jolt-hash-map _o$4913 _o$4914 _o$4915 _o$4916 _o$4917 _o$4918 _o$4919 _o$4920)) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.host" "form-keyword?") member)) (let* ((_a$4921 (var-deref "jolt.ir" "invoke")) (_a$4922 (jolt-invoke (var-deref "jolt.analyzer" "analyze") ctx member env)) (_a$4923 (jolt-vector (jolt-invoke (var-deref "jolt.analyzer" "analyze") ctx (jolt-nth items 1) env)))) (jolt-invoke _a$4921 _a$4922 _a$4923)) (if (jolt-truthy? (keyword #f "else")) (jolt-invoke (var-deref "jolt.analyzer" "uncompilable") "special form . (non-symbol member)") jolt-nil))))))))) analyze-dot))) (guard (e (#t #f)) - (def-var! "jolt.analyzer" "analyze-symbol" (letrec ((analyze-symbol (lambda (ctx form env) (let fnrec4912 ((ctx ctx) (form form) (env env)) (let* ((nm (jolt-invoke (var-deref "jolt.host" "form-sym-name") form)) (ns (jolt-invoke (var-deref "jolt.host" "form-sym-ns") form))) (if (jolt-truthy? (let* ((and__13__auto (jolt-invoke (var-deref "clojure.core" "nil?") ns))) (if (jolt-truthy? and__13__auto) (jolt-invoke (var-deref "jolt.analyzer" "local?") env nm) and__13__auto))) (let* ((h (jolt-get (jolt-get env (keyword #f "hints")) nm))) (if (jolt-truthy? h) (jolt-assoc (jolt-invoke (var-deref "jolt.ir" "local") nm) (keyword #f "hint") h) (jolt-invoke (var-deref "jolt.ir" "local") nm))) (if (jolt-truthy? ns) (let* ((r (jolt-invoke (var-deref "jolt.host" "resolve-global") ctx form))) (if (jolt= (keyword #f "var") (jolt-get r (keyword #f "kind"))) (let* ((_a$4913 (var-deref "jolt.ir" "var-ref")) (_a$4914 (jolt-get r (keyword #f "ns"))) (_a$4915 (jolt-get r (keyword #f "name")))) (jolt-invoke _a$4913 _a$4914 _a$4915)) (jolt-invoke (var-deref "jolt.ir" "host-static") ns nm))) (if (jolt-truthy? (keyword #f "else")) (let* ((r (jolt-invoke (var-deref "jolt.host" "resolve-global") ctx form))) (let* ((G__45 (jolt-get r (keyword #f "kind")))) (if (jolt= G__45 (keyword #f "var")) (let* ((_a$4916 (var-deref "jolt.ir" "var-ref")) (_a$4917 (jolt-get r (keyword #f "ns"))) (_a$4918 (jolt-get r (keyword #f "name")))) (jolt-invoke _a$4916 _a$4917 _a$4918)) (if (jolt= G__45 (keyword #f "host")) (jolt-invoke (var-deref "jolt.ir" "host-ref") (jolt-get r (keyword #f "name"))) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.host" "late-bind?") ctx)) (jolt-invoke (var-deref "jolt.ir" "var-ref") (jolt-invoke (var-deref "jolt.host" "compile-ns") ctx) nm) (jolt-invoke (var-deref "jolt.analyzer" "uncompilable") (jolt-invoke (var-deref "clojure.core" "str") "Unable to resolve symbol: " nm " in this context"))))))) jolt-nil)))))))) analyze-symbol))) + (def-var! "jolt.analyzer" "analyze-field" (letrec ((analyze-field (lambda (ctx hname items env) (let fnrec4924 ((ctx ctx) (hname hname) (items items) (env env)) (begin (if (< (jolt-count items) 2) (jolt-throw (jolt-invoke (var-deref "clojure.core" "str") "Malformed (.-field target) form")) jolt-nil) (let* ((_o$4925 (keyword #f "op")) (_o$4926 (keyword #f "host-call")) (_o$4927 (keyword #f "method")) (_o$4928 (jolt-invoke (var-deref "clojure.core" "subs") hname 1)) (_o$4929 (keyword #f "target")) (_o$4930 (jolt-invoke (var-deref "jolt.analyzer" "analyze") ctx (jolt-nth items 1) env)) (_o$4931 (keyword #f "args")) (_o$4932 (jolt-vector))) (jolt-hash-map _o$4925 _o$4926 _o$4927 _o$4928 _o$4929 _o$4930 _o$4931 _o$4932))))))) analyze-field))) (guard (e (#t #f)) - (def-var! "jolt.analyzer" "analyze-list" (letrec ((analyze-list (lambda (ctx form env) (let fnrec4919 ((ctx ctx) (form form) (env env)) (let* ((items (jolt-invoke (var-deref "clojure.core" "vec") (jolt-invoke (var-deref "jolt.host" "form-elements") form)))) (if (jolt-zero? (jolt-count items)) (jolt-invoke (var-deref "jolt.ir" "quote-node") form) (let* ((head (jolt-first items)) (hname (if (jolt-truthy? (let* ((and__13__auto (jolt-invoke (var-deref "jolt.host" "form-sym?") head))) (if (jolt-truthy? and__13__auto) (jolt-invoke (var-deref "clojure.core" "nil?") (jolt-invoke (var-deref "jolt.host" "form-sym-ns") head)) and__13__auto))) (jolt-invoke (var-deref "jolt.host" "form-sym-name") head) jolt-nil)) (shadowed (let* ((and__13__auto hname)) (if (jolt-truthy? and__13__auto) (jolt-invoke (var-deref "jolt.analyzer" "local?") env hname) and__13__auto)))) (if (jolt-truthy? (let* ((and__13__auto (jolt-invoke (var-deref "jolt.host" "form-sym?") head))) (if (jolt-truthy? and__13__auto) (let* ((and__13__auto (jolt-not shadowed))) (if (jolt-truthy? and__13__auto) (jolt-invoke (var-deref "jolt.host" "form-macro?") ctx head) and__13__auto)) and__13__auto))) (jolt-invoke (var-deref "jolt.analyzer" "analyze") ctx (jolt-invoke (var-deref "jolt.host" "form-expand-1") ctx form) env) (if (jolt-truthy? (let* ((and__13__auto (jolt-invoke (var-deref "jolt.host" "form-sym?") head))) (if (jolt-truthy? and__13__auto) (let* ((and__13__auto (jolt= "jolt.ffi" (jolt-invoke (var-deref "jolt.host" "form-sym-ns") head)))) (if (jolt-truthy? and__13__auto) (jolt= "__cfn" (jolt-invoke (var-deref "jolt.host" "form-sym-name") head)) and__13__auto)) and__13__auto))) (jolt-invoke (var-deref "jolt.analyzer" "analyze-ffi-fn") ctx items env) (if (jolt-truthy? (let* ((and__13__auto hname)) (if (jolt-truthy? and__13__auto) (jolt-contains? (var-deref "jolt.analyzer" "handled") hname) and__13__auto))) (jolt-invoke (var-deref "jolt.analyzer" "analyze-special") ctx hname items env) (if (jolt-truthy? (let* ((and__13__auto hname)) (if (jolt-truthy? and__13__auto) (let* ((and__13__auto (jolt-not shadowed))) (if (jolt-truthy? and__13__auto) (jolt-invoke (var-deref "jolt.analyzer" "method-head?") hname) and__13__auto)) and__13__auto))) (jolt-invoke (var-deref "jolt.analyzer" "analyze-host-call") ctx hname items env) (if (jolt-truthy? (let* ((and__13__auto hname)) (if (jolt-truthy? and__13__auto) (let* ((and__13__auto (jolt-not shadowed))) (if (jolt-truthy? and__13__auto) (jolt-invoke (var-deref "jolt.analyzer" "ctor-head?") hname) and__13__auto)) and__13__auto))) (let* ((_a$4920 (var-deref "jolt.analyzer" "analyze-ctor")) (_a$4921 ctx) (_a$4922 (jolt-invoke (var-deref "clojure.core" "subs") hname 0 (jolt-dec (jolt-count hname)))) (_a$4923 (jolt-rest items)) (_a$4924 env)) (jolt-invoke _a$4920 _a$4921 _a$4922 _a$4923 _a$4924)) (if (jolt-truthy? (let* ((and__13__auto (jolt= hname "new"))) (if (jolt-truthy? and__13__auto) (let* ((and__13__auto (jolt-not shadowed))) (if (jolt-truthy? and__13__auto) (let* ((and__13__auto (>= (jolt-count items) 2))) (if (jolt-truthy? and__13__auto) (jolt-invoke (var-deref "jolt.host" "form-sym?") (jolt-nth items 1)) and__13__auto)) and__13__auto)) and__13__auto))) (let* ((_a$4925 (var-deref "jolt.analyzer" "analyze-ctor")) (_a$4926 ctx) (_a$4927 (jolt-invoke (var-deref "jolt.host" "form-sym-name") (jolt-nth items 1))) (_a$4928 (jolt-drop 2 items)) (_a$4929 env)) (jolt-invoke _a$4925 _a$4926 _a$4927 _a$4928 _a$4929)) (if (jolt-truthy? (let* ((and__13__auto (jolt= hname "."))) (if (jolt-truthy? and__13__auto) (jolt-not shadowed) and__13__auto))) (jolt-invoke (var-deref "jolt.analyzer" "analyze-dot") ctx items env) (if (jolt-truthy? (let* ((and__13__auto hname)) (if (jolt-truthy? and__13__auto) (let* ((and__13__auto (jolt-not shadowed))) (if (jolt-truthy? and__13__auto) (jolt-invoke (var-deref "jolt.analyzer" "field-head?") hname) and__13__auto)) and__13__auto))) (jolt-invoke (var-deref "jolt.analyzer" "analyze-field") ctx hname items env) (if (jolt-truthy? (let* ((and__13__auto hname)) (if (jolt-truthy? and__13__auto) (let* ((and__13__auto (jolt-not shadowed))) (if (jolt-truthy? and__13__auto) (jolt-invoke (var-deref "jolt.host" "form-special?") hname) and__13__auto)) and__13__auto))) (jolt-invoke (var-deref "jolt.analyzer" "uncompilable") (jolt-invoke (var-deref "clojure.core" "str") "special form " hname)) (if (jolt-truthy? (keyword #f "else")) (let* ((n (let* ((_a$4934 (var-deref "jolt.ir" "invoke")) (_a$4935 (jolt-invoke (var-deref "jolt.analyzer" "analyze") ctx head env)) (_a$4936 (let* ((_a$4931 (var-deref "clojure.core" "mapv")) (_a$4932 (lambda (p__54_) (let fnrec4930 ((p__54_ p__54_)) (jolt-invoke (var-deref "jolt.analyzer" "analyze") ctx p__54_ env)))) (_a$4933 (jolt-rest items))) (jolt-invoke _a$4931 _a$4932 _a$4933)))) (jolt-invoke _a$4934 _a$4935 _a$4936))) (p (jolt-invoke (var-deref "jolt.host" "form-position") form))) (if (jolt-truthy? p) (jolt-assoc n (keyword #f "pos") p) n)) jolt-nil))))))))))))))))) analyze-list))) + (def-var! "jolt.analyzer" "analyze-symbol" (letrec ((analyze-symbol (lambda (ctx form env) (let fnrec4933 ((ctx ctx) (form form) (env env)) (let* ((nm (jolt-invoke (var-deref "jolt.host" "form-sym-name") form)) (ns (jolt-invoke (var-deref "jolt.host" "form-sym-ns") form))) (if (jolt-truthy? (let* ((and__13__auto (jolt-invoke (var-deref "clojure.core" "nil?") ns))) (if (jolt-truthy? and__13__auto) (jolt-invoke (var-deref "jolt.analyzer" "local?") env nm) and__13__auto))) (let* ((h (jolt-get (jolt-get env (keyword #f "hints")) nm))) (if (jolt-truthy? h) (jolt-assoc (jolt-invoke (var-deref "jolt.ir" "local") nm) (keyword #f "hint") h) (jolt-invoke (var-deref "jolt.ir" "local") nm))) (if (jolt-truthy? ns) (let* ((r (jolt-invoke (var-deref "jolt.host" "resolve-global") ctx form))) (if (jolt= (keyword #f "var") (jolt-get r (keyword #f "kind"))) (let* ((_a$4934 (var-deref "jolt.ir" "var-ref")) (_a$4935 (jolt-get r (keyword #f "ns"))) (_a$4936 (jolt-get r (keyword #f "name")))) (jolt-invoke _a$4934 _a$4935 _a$4936)) (jolt-invoke (var-deref "jolt.ir" "host-static") ns nm))) (if (jolt-truthy? (keyword #f "else")) (let* ((r (jolt-invoke (var-deref "jolt.host" "resolve-global") ctx form))) (let* ((G__45 (jolt-get r (keyword #f "kind")))) (if (jolt= G__45 (keyword #f "var")) (let* ((_a$4937 (var-deref "jolt.ir" "var-ref")) (_a$4938 (jolt-get r (keyword #f "ns"))) (_a$4939 (jolt-get r (keyword #f "name")))) (jolt-invoke _a$4937 _a$4938 _a$4939)) (if (jolt= G__45 (keyword #f "host")) (jolt-invoke (var-deref "jolt.ir" "host-ref") (jolt-get r (keyword #f "name"))) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.host" "late-bind?") ctx)) (jolt-invoke (var-deref "jolt.ir" "var-ref") (jolt-invoke (var-deref "jolt.host" "compile-ns") ctx) nm) (jolt-invoke (var-deref "jolt.analyzer" "uncompilable") (jolt-invoke (var-deref "clojure.core" "str") "Unable to resolve symbol: " nm " in this context"))))))) jolt-nil)))))))) analyze-symbol))) (guard (e (#t #f)) - (def-var! "jolt.analyzer" "analyze" (letrec ((analyze (case-lambda ((ctx form) (let fnrec4937 ((ctx ctx) (form form)) (jolt-invoke analyze ctx form (jolt-invoke (var-deref "jolt.analyzer" "empty-env"))))) ((ctx form env) (let fnrec4938 ((ctx ctx) (form form) (env env)) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.host" "form-literal?") form)) (jolt-invoke (var-deref "jolt.ir" "const") form) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.host" "form-sym?") form)) (jolt-invoke (var-deref "jolt.analyzer" "analyze-symbol") ctx form env) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.host" "form-vec?") form)) (jolt-invoke (var-deref "jolt.ir" "vector-node") (let* ((_a$4940 (var-deref "clojure.core" "mapv")) (_a$4941 (lambda (p__55_) (let fnrec4939 ((p__55_ p__55_)) (jolt-invoke analyze ctx p__55_ env)))) (_a$4942 (jolt-invoke (var-deref "jolt.host" "form-vec-items") form))) (jolt-invoke _a$4940 _a$4941 _a$4942))) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.host" "form-map?") form)) (jolt-invoke (var-deref "jolt.ir" "map-node") (let* ((_a$4946 (var-deref "clojure.core" "mapv")) (_a$4947 (lambda (p) (let fnrec4943 ((p p)) (let* ((_o$4944 (jolt-invoke analyze ctx (jolt-first p) env)) (_o$4945 (jolt-invoke analyze ctx (jolt-invoke (var-deref "clojure.core" "second") p) env))) (jolt-vector _o$4944 _o$4945))))) (_a$4948 (jolt-invoke (var-deref "jolt.host" "form-map-pairs") form))) (jolt-invoke _a$4946 _a$4947 _a$4948))) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.host" "form-set?") form)) (jolt-invoke (var-deref "jolt.ir" "set-node") (let* ((_a$4950 (var-deref "clojure.core" "mapv")) (_a$4951 (lambda (p__56_) (let fnrec4949 ((p__56_ p__56_)) (jolt-invoke analyze ctx p__56_ env)))) (_a$4952 (jolt-invoke (var-deref "jolt.host" "form-set-items") form))) (jolt-invoke _a$4950 _a$4951 _a$4952))) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.host" "form-list?") form)) (jolt-invoke (var-deref "jolt.analyzer" "analyze-list") ctx form env) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.host" "form-regex?") form)) (let* ((_o$4953 (keyword #f "op")) (_o$4954 (keyword #f "regex")) (_o$4955 (keyword #f "source")) (_o$4956 (jolt-invoke (var-deref "jolt.host" "form-regex-source") form))) (jolt-hash-map _o$4953 _o$4954 _o$4955 _o$4956)) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.host" "form-inst?") form)) (let* ((_o$4957 (keyword #f "op")) (_o$4958 (keyword #f "inst")) (_o$4959 (keyword #f "source")) (_o$4960 (jolt-invoke (var-deref "jolt.host" "form-inst-source") form))) (jolt-hash-map _o$4957 _o$4958 _o$4959 _o$4960)) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.host" "form-uuid?") form)) (let* ((_o$4961 (keyword #f "op")) (_o$4962 (keyword #f "uuid")) (_o$4963 (keyword #f "source")) (_o$4964 (jolt-invoke (var-deref "jolt.host" "form-uuid-source") form))) (jolt-hash-map _o$4961 _o$4962 _o$4963 _o$4964)) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.host" "form-bigdec?") form)) (let* ((_o$4965 (keyword #f "op")) (_o$4966 (keyword #f "bigdec")) (_o$4967 (keyword #f "source")) (_o$4968 (jolt-invoke (var-deref "jolt.host" "form-bigdec-source") form))) (jolt-hash-map _o$4965 _o$4966 _o$4967 _o$4968)) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.host" "form-ns-value?") form)) (let* ((_o$4969 (keyword #f "op")) (_o$4970 (keyword #f "the-ns")) (_o$4971 (keyword #f "name")) (_o$4972 (jolt-invoke (var-deref "jolt.host" "form-ns-value-name") form))) (jolt-hash-map _o$4969 _o$4970 _o$4971 _o$4972)) (if (jolt-truthy? (keyword #f "else")) (jolt-invoke (var-deref "jolt.analyzer" "uncompilable") "unsupported form") jolt-nil))))))))))))))))) analyze))) + (def-var! "jolt.analyzer" "analyze-list" (letrec ((analyze-list (lambda (ctx form env) (let fnrec4940 ((ctx ctx) (form form) (env env)) (let* ((items (jolt-invoke (var-deref "clojure.core" "vec") (jolt-invoke (var-deref "jolt.host" "form-elements") form)))) (if (jolt-zero? (jolt-count items)) (jolt-invoke (var-deref "jolt.ir" "quote-node") form) (let* ((head (jolt-first items)) (hname (if (jolt-truthy? (let* ((and__13__auto (jolt-invoke (var-deref "jolt.host" "form-sym?") head))) (if (jolt-truthy? and__13__auto) (jolt-invoke (var-deref "clojure.core" "nil?") (jolt-invoke (var-deref "jolt.host" "form-sym-ns") head)) and__13__auto))) (jolt-invoke (var-deref "jolt.host" "form-sym-name") head) jolt-nil)) (shadowed (let* ((and__13__auto hname)) (if (jolt-truthy? and__13__auto) (jolt-invoke (var-deref "jolt.analyzer" "local?") env hname) and__13__auto)))) (if (jolt-truthy? (let* ((and__13__auto (jolt-invoke (var-deref "jolt.host" "form-sym?") head))) (if (jolt-truthy? and__13__auto) (let* ((and__13__auto (jolt-not shadowed))) (if (jolt-truthy? and__13__auto) (jolt-invoke (var-deref "jolt.host" "form-macro?") ctx head) and__13__auto)) and__13__auto))) (jolt-invoke (var-deref "jolt.analyzer" "analyze") ctx (jolt-invoke (var-deref "jolt.host" "form-expand-1") ctx form) env) (if (jolt-truthy? (let* ((and__13__auto (jolt-invoke (var-deref "jolt.host" "form-sym?") head))) (if (jolt-truthy? and__13__auto) (let* ((and__13__auto (jolt= "jolt.ffi" (jolt-invoke (var-deref "jolt.host" "form-sym-ns") head)))) (if (jolt-truthy? and__13__auto) (jolt= "__cfn" (jolt-invoke (var-deref "jolt.host" "form-sym-name") head)) and__13__auto)) and__13__auto))) (jolt-invoke (var-deref "jolt.analyzer" "analyze-ffi-fn") ctx items env) (if (jolt-truthy? (let* ((and__13__auto (jolt-invoke (var-deref "jolt.host" "form-sym?") head))) (if (jolt-truthy? and__13__auto) (let* ((and__13__auto (jolt= "jolt.ffi" (jolt-invoke (var-deref "jolt.host" "form-sym-ns") head)))) (if (jolt-truthy? and__13__auto) (jolt= "__ccallable" (jolt-invoke (var-deref "jolt.host" "form-sym-name") head)) and__13__auto)) and__13__auto))) (jolt-invoke (var-deref "jolt.analyzer" "analyze-ffi-callable") ctx items env) (if (jolt-truthy? (let* ((and__13__auto hname)) (if (jolt-truthy? and__13__auto) (jolt-contains? (var-deref "jolt.analyzer" "handled") hname) and__13__auto))) (jolt-invoke (var-deref "jolt.analyzer" "analyze-special") ctx hname items env) (if (jolt-truthy? (let* ((and__13__auto hname)) (if (jolt-truthy? and__13__auto) (let* ((and__13__auto (jolt-not shadowed))) (if (jolt-truthy? and__13__auto) (jolt-invoke (var-deref "jolt.analyzer" "method-head?") hname) and__13__auto)) and__13__auto))) (jolt-invoke (var-deref "jolt.analyzer" "analyze-host-call") ctx hname items env) (if (jolt-truthy? (let* ((and__13__auto hname)) (if (jolt-truthy? and__13__auto) (let* ((and__13__auto (jolt-not shadowed))) (if (jolt-truthy? and__13__auto) (jolt-invoke (var-deref "jolt.analyzer" "ctor-head?") hname) and__13__auto)) and__13__auto))) (let* ((_a$4941 (var-deref "jolt.analyzer" "analyze-ctor")) (_a$4942 ctx) (_a$4943 (jolt-invoke (var-deref "clojure.core" "subs") hname 0 (jolt-dec (jolt-count hname)))) (_a$4944 (jolt-rest items)) (_a$4945 env)) (jolt-invoke _a$4941 _a$4942 _a$4943 _a$4944 _a$4945)) (if (jolt-truthy? (let* ((and__13__auto (jolt= hname "new"))) (if (jolt-truthy? and__13__auto) (let* ((and__13__auto (jolt-not shadowed))) (if (jolt-truthy? and__13__auto) (let* ((and__13__auto (>= (jolt-count items) 2))) (if (jolt-truthy? and__13__auto) (jolt-invoke (var-deref "jolt.host" "form-sym?") (jolt-nth items 1)) and__13__auto)) and__13__auto)) and__13__auto))) (let* ((_a$4946 (var-deref "jolt.analyzer" "analyze-ctor")) (_a$4947 ctx) (_a$4948 (jolt-invoke (var-deref "jolt.host" "form-sym-name") (jolt-nth items 1))) (_a$4949 (jolt-drop 2 items)) (_a$4950 env)) (jolt-invoke _a$4946 _a$4947 _a$4948 _a$4949 _a$4950)) (if (jolt-truthy? (let* ((and__13__auto (jolt= hname "."))) (if (jolt-truthy? and__13__auto) (jolt-not shadowed) and__13__auto))) (jolt-invoke (var-deref "jolt.analyzer" "analyze-dot") ctx items env) (if (jolt-truthy? (let* ((and__13__auto hname)) (if (jolt-truthy? and__13__auto) (let* ((and__13__auto (jolt-not shadowed))) (if (jolt-truthy? and__13__auto) (jolt-invoke (var-deref "jolt.analyzer" "field-head?") hname) and__13__auto)) and__13__auto))) (jolt-invoke (var-deref "jolt.analyzer" "analyze-field") ctx hname items env) (if (jolt-truthy? (let* ((and__13__auto hname)) (if (jolt-truthy? and__13__auto) (let* ((and__13__auto (jolt-not shadowed))) (if (jolt-truthy? and__13__auto) (jolt-invoke (var-deref "jolt.host" "form-special?") hname) and__13__auto)) and__13__auto))) (jolt-invoke (var-deref "jolt.analyzer" "uncompilable") (jolt-invoke (var-deref "clojure.core" "str") "special form " hname)) (if (jolt-truthy? (keyword #f "else")) (let* ((n (let* ((_a$4955 (var-deref "jolt.ir" "invoke")) (_a$4956 (jolt-invoke (var-deref "jolt.analyzer" "analyze") ctx head env)) (_a$4957 (let* ((_a$4952 (var-deref "clojure.core" "mapv")) (_a$4953 (lambda (p__54_) (let fnrec4951 ((p__54_ p__54_)) (jolt-invoke (var-deref "jolt.analyzer" "analyze") ctx p__54_ env)))) (_a$4954 (jolt-rest items))) (jolt-invoke _a$4952 _a$4953 _a$4954)))) (jolt-invoke _a$4955 _a$4956 _a$4957))) (p (jolt-invoke (var-deref "jolt.host" "form-position") form))) (if (jolt-truthy? p) (jolt-assoc n (keyword #f "pos") p) n)) jolt-nil)))))))))))))))))) analyze-list))) +(guard (e (#t #f)) + (def-var! "jolt.analyzer" "analyze" (letrec ((analyze (case-lambda ((ctx form) (let fnrec4958 ((ctx ctx) (form form)) (jolt-invoke analyze ctx form (jolt-invoke (var-deref "jolt.analyzer" "empty-env"))))) ((ctx form env) (let fnrec4959 ((ctx ctx) (form form) (env env)) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.host" "form-literal?") form)) (jolt-invoke (var-deref "jolt.ir" "const") form) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.host" "form-sym?") form)) (jolt-invoke (var-deref "jolt.analyzer" "analyze-symbol") ctx form env) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.host" "form-vec?") form)) (jolt-invoke (var-deref "jolt.ir" "vector-node") (let* ((_a$4961 (var-deref "clojure.core" "mapv")) (_a$4962 (lambda (p__55_) (let fnrec4960 ((p__55_ p__55_)) (jolt-invoke analyze ctx p__55_ env)))) (_a$4963 (jolt-invoke (var-deref "jolt.host" "form-vec-items") form))) (jolt-invoke _a$4961 _a$4962 _a$4963))) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.host" "form-map?") form)) (jolt-invoke (var-deref "jolt.ir" "map-node") (let* ((_a$4967 (var-deref "clojure.core" "mapv")) (_a$4968 (lambda (p) (let fnrec4964 ((p p)) (let* ((_o$4965 (jolt-invoke analyze ctx (jolt-first p) env)) (_o$4966 (jolt-invoke analyze ctx (jolt-invoke (var-deref "clojure.core" "second") p) env))) (jolt-vector _o$4965 _o$4966))))) (_a$4969 (jolt-invoke (var-deref "jolt.host" "form-map-pairs") form))) (jolt-invoke _a$4967 _a$4968 _a$4969))) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.host" "form-set?") form)) (jolt-invoke (var-deref "jolt.ir" "set-node") (let* ((_a$4971 (var-deref "clojure.core" "mapv")) (_a$4972 (lambda (p__56_) (let fnrec4970 ((p__56_ p__56_)) (jolt-invoke analyze ctx p__56_ env)))) (_a$4973 (jolt-invoke (var-deref "jolt.host" "form-set-items") form))) (jolt-invoke _a$4971 _a$4972 _a$4973))) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.host" "form-list?") form)) (jolt-invoke (var-deref "jolt.analyzer" "analyze-list") ctx form env) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.host" "form-regex?") form)) (let* ((_o$4974 (keyword #f "op")) (_o$4975 (keyword #f "regex")) (_o$4976 (keyword #f "source")) (_o$4977 (jolt-invoke (var-deref "jolt.host" "form-regex-source") form))) (jolt-hash-map _o$4974 _o$4975 _o$4976 _o$4977)) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.host" "form-inst?") form)) (let* ((_o$4978 (keyword #f "op")) (_o$4979 (keyword #f "inst")) (_o$4980 (keyword #f "source")) (_o$4981 (jolt-invoke (var-deref "jolt.host" "form-inst-source") form))) (jolt-hash-map _o$4978 _o$4979 _o$4980 _o$4981)) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.host" "form-uuid?") form)) (let* ((_o$4982 (keyword #f "op")) (_o$4983 (keyword #f "uuid")) (_o$4984 (keyword #f "source")) (_o$4985 (jolt-invoke (var-deref "jolt.host" "form-uuid-source") form))) (jolt-hash-map _o$4982 _o$4983 _o$4984 _o$4985)) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.host" "form-bigdec?") form)) (let* ((_o$4986 (keyword #f "op")) (_o$4987 (keyword #f "bigdec")) (_o$4988 (keyword #f "source")) (_o$4989 (jolt-invoke (var-deref "jolt.host" "form-bigdec-source") form))) (jolt-hash-map _o$4986 _o$4987 _o$4988 _o$4989)) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.host" "form-ns-value?") form)) (let* ((_o$4990 (keyword #f "op")) (_o$4991 (keyword #f "the-ns")) (_o$4992 (keyword #f "name")) (_o$4993 (jolt-invoke (var-deref "jolt.host" "form-ns-value-name") form))) (jolt-hash-map _o$4990 _o$4991 _o$4992 _o$4993)) (if (jolt-truthy? (keyword #f "else")) (jolt-invoke (var-deref "jolt.analyzer" "uncompilable") "unsupported form") jolt-nil))))))))))))))))) analyze))) (guard (e (#t #f)) (def-var-with-meta! "jolt.backend-scheme" "native-ops" (let* ((_o$3733 "+") (_o$3734 "+") (_o$3735 "-") (_o$3736 "-") (_o$3737 "*") (_o$3738 "*") (_o$3739 "/") (_o$3740 "/") (_o$3741 "<") (_o$3742 "<") (_o$3743 ">") (_o$3744 ">") (_o$3745 "<=") (_o$3746 "<=") (_o$3747 ">=") (_o$3748 ">=") (_o$3749 "=") (_o$3750 "jolt=") (_o$3751 "inc") (_o$3752 "jolt-inc") (_o$3753 "dec") (_o$3754 "jolt-dec") (_o$3755 "not") (_o$3756 "jolt-not") (_o$3757 "min") (_o$3758 "min") (_o$3759 "max") (_o$3760 "max") (_o$3761 "mod") (_o$3762 "modulo") (_o$3763 "rem") (_o$3764 "remainder") (_o$3765 "quot") (_o$3766 "quotient") (_o$3767 "vector") (_o$3768 "jolt-vector") (_o$3769 "hash-map") (_o$3770 "jolt-hash-map") (_o$3771 "hash-set") (_o$3772 "jolt-hash-set") (_o$3773 "conj") (_o$3774 "jolt-conj") (_o$3775 "get") (_o$3776 "jolt-get") (_o$3777 "nth") (_o$3778 "jolt-nth") (_o$3779 "count") (_o$3780 "jolt-count") (_o$3781 "assoc") (_o$3782 "jolt-assoc") (_o$3783 "dissoc") (_o$3784 "jolt-dissoc") (_o$3785 "contains?") (_o$3786 "jolt-contains?") (_o$3787 "empty?") (_o$3788 "jolt-empty?") (_o$3789 "peek") (_o$3790 "jolt-peek") (_o$3791 "pop") (_o$3792 "jolt-pop") (_o$3793 "first") (_o$3794 "jolt-first") (_o$3795 "rest") (_o$3796 "jolt-rest") (_o$3797 "next") (_o$3798 "jolt-next") (_o$3799 "seq") (_o$3800 "jolt-seq") (_o$3801 "cons") (_o$3802 "jolt-cons") (_o$3803 "list") (_o$3804 "jolt-list") (_o$3805 "reverse") (_o$3806 "jolt-reverse") (_o$3807 "last") (_o$3808 "jolt-last") (_o$3809 "map") (_o$3810 "jolt-map") (_o$3811 "filter") (_o$3812 "jolt-filter") (_o$3813 "remove") (_o$3814 "jolt-remove") (_o$3815 "reduce") (_o$3816 "jolt-reduce") (_o$3817 "into") (_o$3818 "jolt-into") (_o$3819 "concat") (_o$3820 "jolt-concat") (_o$3821 "apply") (_o$3822 "jolt-apply") (_o$3823 "range") (_o$3824 "jolt-range") (_o$3825 "take") (_o$3826 "jolt-take") (_o$3827 "drop") (_o$3828 "jolt-drop") (_o$3829 "keys") (_o$3830 "jolt-keys") (_o$3831 "vals") (_o$3832 "jolt-vals") (_o$3833 "even?") (_o$3834 "jolt-even?") (_o$3835 "odd?") (_o$3836 "jolt-odd?") (_o$3837 "pos?") (_o$3838 "jolt-pos?") (_o$3839 "neg?") (_o$3840 "jolt-neg?") (_o$3841 "zero?") (_o$3842 "jolt-zero?") (_o$3843 "identity") (_o$3844 "jolt-identity") (_o$3845 "ex-info") (_o$3846 "jolt-ex-info")) (jolt-hash-map _o$3733 _o$3734 _o$3735 _o$3736 _o$3737 _o$3738 _o$3739 _o$3740 _o$3741 _o$3742 _o$3743 _o$3744 _o$3745 _o$3746 _o$3747 _o$3748 _o$3749 _o$3750 _o$3751 _o$3752 _o$3753 _o$3754 _o$3755 _o$3756 _o$3757 _o$3758 _o$3759 _o$3760 _o$3761 _o$3762 _o$3763 _o$3764 _o$3765 _o$3766 _o$3767 _o$3768 _o$3769 _o$3770 _o$3771 _o$3772 _o$3773 _o$3774 _o$3775 _o$3776 _o$3777 _o$3778 _o$3779 _o$3780 _o$3781 _o$3782 _o$3783 _o$3784 _o$3785 _o$3786 _o$3787 _o$3788 _o$3789 _o$3790 _o$3791 _o$3792 _o$3793 _o$3794 _o$3795 _o$3796 _o$3797 _o$3798 _o$3799 _o$3800 _o$3801 _o$3802 _o$3803 _o$3804 _o$3805 _o$3806 _o$3807 _o$3808 _o$3809 _o$3810 _o$3811 _o$3812 _o$3813 _o$3814 _o$3815 _o$3816 _o$3817 _o$3818 _o$3819 _o$3820 _o$3821 _o$3822 _o$3823 _o$3824 _o$3825 _o$3826 _o$3827 _o$3828 _o$3829 _o$3830 _o$3831 _o$3832 _o$3833 _o$3834 _o$3835 _o$3836 _o$3837 _o$3838 _o$3839 _o$3840 _o$3841 _o$3842 _o$3843 _o$3844 _o$3845 _o$3846)) (jolt-hash-map (keyword #f "private") #t))) (guard (e (#t #f)) @@ -175,37 +177,39 @@ (guard (e (#t #f)) (def-var! "jolt.backend-scheme" "emit-ffi-fn" (letrec ((emit-ffi-fn (lambda (node) (let fnrec4146 ((node node)) (let* ((_a$4147 (var-deref "clojure.core" "str")) (_a$4148 "(foreign-procedure ") (_a$4149 (if (jolt-truthy? (jolt-get node (keyword #f "blocking"))) "__collect_safe " jolt-nil)) (_a$4150 (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") (jolt-get node (keyword #f "csym")))) (_a$4151 " (") (_a$4152 (jolt-invoke (var-deref "clojure.string" "join") " " (jolt-map (var-deref "jolt.backend-scheme" "ffi-type->chez") (jolt-get node (keyword #f "argtypes"))))) (_a$4153 ") ") (_a$4154 (jolt-invoke (var-deref "jolt.backend-scheme" "ffi-type->chez") (jolt-get node (keyword #f "rettype")))) (_a$4155 ")")) (jolt-invoke _a$4147 _a$4148 _a$4149 _a$4150 _a$4151 _a$4152 _a$4153 _a$4154 _a$4155)))))) emit-ffi-fn))) (guard (e (#t #f)) - (def-var! "jolt.backend-scheme" "emit-recur" (letrec ((emit-recur (lambda (node) (let fnrec4156 ((node node)) (begin (if (jolt-not (var-deref "jolt.backend-scheme" "*recur-target*")) (jolt-throw (jolt-ex-info "emit: recur outside a loop/fn target" (jolt-hash-map))) jolt-nil) (let* ((arg-nodes (jolt-get node (keyword #f "args")))) (let* ((_a$4158 (var-deref "jolt.backend-scheme" "ordered-call")) (_a$4159 arg-nodes) (_a$4160 (jolt-invoke (var-deref "clojure.core" "mapv") (var-deref "jolt.backend-scheme" "emit") arg-nodes)) (_a$4161 (lambda (as) (let fnrec4157 ((as as)) (jolt-invoke (var-deref "clojure.core" "str") "(" (var-deref "jolt.backend-scheme" "*recur-target*") " " (jolt-invoke (var-deref "clojure.string" "join") " " as) ")"))))) (jolt-invoke _a$4158 _a$4159 _a$4160 _a$4161)))))))) emit-recur))) + (def-var! "jolt.backend-scheme" "emit-ffi-callable" (letrec ((emit-ffi-callable (lambda (node) (let fnrec4156 ((node node)) (let* ((_a$4157 (var-deref "clojure.core" "str")) (_a$4158 "(jolt-ffi-register-callable! (foreign-callable ") (_a$4159 (if (jolt-truthy? (jolt-get node (keyword #f "collect-safe"))) "__collect_safe " jolt-nil)) (_a$4160 (jolt-invoke (var-deref "jolt.backend-scheme" "emit") (jolt-get node (keyword #f "fn")))) (_a$4161 " (") (_a$4162 (jolt-invoke (var-deref "clojure.string" "join") " " (jolt-map (var-deref "jolt.backend-scheme" "ffi-type->chez") (jolt-get node (keyword #f "argtypes"))))) (_a$4163 ") ") (_a$4164 (jolt-invoke (var-deref "jolt.backend-scheme" "ffi-type->chez") (jolt-get node (keyword #f "rettype")))) (_a$4165 "))")) (jolt-invoke _a$4157 _a$4158 _a$4159 _a$4160 _a$4161 _a$4162 _a$4163 _a$4164 _a$4165)))))) emit-ffi-callable))) (guard (e (#t #f)) - (def-var! "jolt.backend-scheme" "emit-arity-clause" (letrec ((emit-arity-clause (lambda (a) (let fnrec4162 ((a a)) (let* ((params (jolt-map (var-deref "jolt.backend-scheme" "munge-name") (jolt-get a (keyword #f "params")))) (restp (let* ((temp__15__auto (jolt-get a (keyword #f "rest")))) (if (jolt-truthy? temp__15__auto) (let* ((r temp__15__auto)) (jolt-invoke (var-deref "jolt.backend-scheme" "munge-name") r)) jolt-nil))) (label (jolt-invoke (var-deref "jolt.backend-scheme" "fresh-label") "fnrec")) (body (let* ((frame__8__auto (jolt-invoke (var-deref "clojure.core" "array-map") (jolt-var "jolt.backend-scheme" "*recur-target*") label))) (begin (jolt-invoke (var-deref "clojure.core" "push-thread-bindings") frame__8__auto) (dynamic-wind (lambda () #f) (lambda () (jolt-invoke (var-deref "jolt.backend-scheme" "emit") (jolt-get a (keyword #f "body")))) (lambda () (jolt-invoke (var-deref "clojure.core" "pop-thread-bindings"))))))) (paramlist (if (jolt-truthy? (let* ((and__13__auto restp)) (if (jolt-truthy? and__13__auto) (jolt-empty? params) and__13__auto))) restp (if (jolt-truthy? restp) (jolt-invoke (var-deref "clojure.core" "str") "(" (jolt-invoke (var-deref "clojure.string" "join") " " params) " . " restp ")") (if (jolt-truthy? (keyword #f "else")) (jolt-invoke (var-deref "clojure.core" "str") "(" (jolt-invoke (var-deref "clojure.string" "join") " " params) ")") jolt-nil)))) (binds (if (jolt-truthy? restp) (let* ((_a$4164 (jolt-map (lambda (p) (let fnrec4163 ((p p)) (jolt-invoke (var-deref "clojure.core" "str") "(" p " " p ")"))) params)) (_a$4165 (jolt-vector (jolt-invoke (var-deref "clojure.core" "str") "(" restp " (list->cseq " restp "))")))) (jolt-concat _a$4164 _a$4165)) (jolt-map (lambda (p) (let fnrec4166 ((p p)) (jolt-invoke (var-deref "clojure.core" "str") "(" p " " p ")"))) params)))) (let* ((_o$4167 paramlist) (_o$4168 (jolt-invoke (var-deref "clojure.core" "str") "(let " label " (" (jolt-invoke (var-deref "clojure.string" "join") " " binds) ") " body ")"))) (jolt-vector _o$4167 _o$4168))))))) emit-arity-clause))) + (def-var! "jolt.backend-scheme" "emit-recur" (letrec ((emit-recur (lambda (node) (let fnrec4166 ((node node)) (begin (if (jolt-not (var-deref "jolt.backend-scheme" "*recur-target*")) (jolt-throw (jolt-ex-info "emit: recur outside a loop/fn target" (jolt-hash-map))) jolt-nil) (let* ((arg-nodes (jolt-get node (keyword #f "args")))) (let* ((_a$4168 (var-deref "jolt.backend-scheme" "ordered-call")) (_a$4169 arg-nodes) (_a$4170 (jolt-invoke (var-deref "clojure.core" "mapv") (var-deref "jolt.backend-scheme" "emit") arg-nodes)) (_a$4171 (lambda (as) (let fnrec4167 ((as as)) (jolt-invoke (var-deref "clojure.core" "str") "(" (var-deref "jolt.backend-scheme" "*recur-target*") " " (jolt-invoke (var-deref "clojure.string" "join") " " as) ")"))))) (jolt-invoke _a$4168 _a$4169 _a$4170 _a$4171)))))))) emit-recur))) (guard (e (#t #f)) - (def-var! "jolt.backend-scheme" "emit-fn" (letrec ((emit-fn (lambda (node) (let fnrec4169 ((node node)) (let* ((arities (jolt-get node (keyword #f "arities"))) (self (let* ((temp__15__auto (jolt-get node (keyword #f "name")))) (if (jolt-truthy? temp__15__auto) (let* ((nm temp__15__auto)) (jolt-invoke (var-deref "jolt.backend-scheme" "munge-name") nm)) jolt-nil))) (clauses (let* ((frame__8__auto (jolt-invoke (var-deref "clojure.core" "array-map") (jolt-var "jolt.backend-scheme" "*known-procs*") (if (jolt-truthy? self) (jolt-conj (var-deref "jolt.backend-scheme" "*known-procs*") self) (var-deref "jolt.backend-scheme" "*known-procs*"))))) (begin (jolt-invoke (var-deref "clojure.core" "push-thread-bindings") frame__8__auto) (dynamic-wind (lambda () #f) (lambda () (jolt-invoke (var-deref "clojure.core" "mapv") (var-deref "jolt.backend-scheme" "emit-arity-clause") arities)) (lambda () (jolt-invoke (var-deref "clojure.core" "pop-thread-bindings"))))))) (_lambda (if (jolt= 1 (jolt-count clauses)) (let* ((c (jolt-first clauses))) (let* ((_a$4170 (var-deref "clojure.core" "str")) (_a$4171 "(lambda ") (_a$4172 (jolt-nth c 0)) (_a$4173 " ") (_a$4174 (jolt-nth c 1)) (_a$4175 ")")) (jolt-invoke _a$4170 _a$4171 _a$4172 _a$4173 _a$4174 _a$4175))) (jolt-invoke (var-deref "clojure.core" "str") "(case-lambda " (jolt-invoke (var-deref "clojure.string" "join") " " (jolt-map (lambda (c) (let fnrec4176 ((c c)) (let* ((_a$4177 (var-deref "clojure.core" "str")) (_a$4178 "(") (_a$4179 (jolt-nth c 0)) (_a$4180 " ") (_a$4181 (jolt-nth c 1)) (_a$4182 ")")) (jolt-invoke _a$4177 _a$4178 _a$4179 _a$4180 _a$4181 _a$4182)))) clauses)) ")")))) (let* ((temp__4__auto (jolt-get node (keyword #f "name")))) (if (jolt-truthy? temp__4__auto) (let* ((nm temp__4__auto)) (let* ((m (jolt-invoke (var-deref "jolt.backend-scheme" "munge-name") nm))) (jolt-invoke (var-deref "clojure.core" "str") "(letrec ((" m " " _lambda ")) " m ")"))) _lambda))))))) emit-fn))) + (def-var! "jolt.backend-scheme" "emit-arity-clause" (letrec ((emit-arity-clause (lambda (a) (let fnrec4172 ((a a)) (let* ((params (jolt-map (var-deref "jolt.backend-scheme" "munge-name") (jolt-get a (keyword #f "params")))) (restp (let* ((temp__15__auto (jolt-get a (keyword #f "rest")))) (if (jolt-truthy? temp__15__auto) (let* ((r temp__15__auto)) (jolt-invoke (var-deref "jolt.backend-scheme" "munge-name") r)) jolt-nil))) (label (jolt-invoke (var-deref "jolt.backend-scheme" "fresh-label") "fnrec")) (body (let* ((frame__8__auto (jolt-invoke (var-deref "clojure.core" "array-map") (jolt-var "jolt.backend-scheme" "*recur-target*") label))) (begin (jolt-invoke (var-deref "clojure.core" "push-thread-bindings") frame__8__auto) (dynamic-wind (lambda () #f) (lambda () (jolt-invoke (var-deref "jolt.backend-scheme" "emit") (jolt-get a (keyword #f "body")))) (lambda () (jolt-invoke (var-deref "clojure.core" "pop-thread-bindings"))))))) (paramlist (if (jolt-truthy? (let* ((and__13__auto restp)) (if (jolt-truthy? and__13__auto) (jolt-empty? params) and__13__auto))) restp (if (jolt-truthy? restp) (jolt-invoke (var-deref "clojure.core" "str") "(" (jolt-invoke (var-deref "clojure.string" "join") " " params) " . " restp ")") (if (jolt-truthy? (keyword #f "else")) (jolt-invoke (var-deref "clojure.core" "str") "(" (jolt-invoke (var-deref "clojure.string" "join") " " params) ")") jolt-nil)))) (binds (if (jolt-truthy? restp) (let* ((_a$4174 (jolt-map (lambda (p) (let fnrec4173 ((p p)) (jolt-invoke (var-deref "clojure.core" "str") "(" p " " p ")"))) params)) (_a$4175 (jolt-vector (jolt-invoke (var-deref "clojure.core" "str") "(" restp " (list->cseq " restp "))")))) (jolt-concat _a$4174 _a$4175)) (jolt-map (lambda (p) (let fnrec4176 ((p p)) (jolt-invoke (var-deref "clojure.core" "str") "(" p " " p ")"))) params)))) (let* ((_o$4177 paramlist) (_o$4178 (jolt-invoke (var-deref "clojure.core" "str") "(let " label " (" (jolt-invoke (var-deref "clojure.string" "join") " " binds) ") " body ")"))) (jolt-vector _o$4177 _o$4178))))))) emit-arity-clause))) (guard (e (#t #f)) - (def-var! "jolt.backend-scheme" "native-op" (letrec ((native-op (lambda (fnode nargs) (let fnrec4183 ((fnode fnode) (nargs nargs)) (let* ((nm (let* ((G__34 (jolt-get fnode (keyword #f "op")))) (if (jolt= G__34 (keyword #f "var")) (if (jolt= "clojure.core" (jolt-get fnode (keyword #f "ns"))) (jolt-get fnode (keyword #f "name")) jolt-nil) (if (jolt= G__34 (keyword #f "host")) (jolt-get fnode (keyword #f "name")) jolt-nil)))) (op (if (jolt-truthy? nm) (jolt-invoke (var-deref "jolt.backend-scheme" "native-ops") nm) jolt-nil)) (arity-ok (if (jolt-truthy? nm) (jolt-invoke (var-deref "jolt.backend-scheme" "op-arity") nm) jolt-nil))) (if (jolt-truthy? (jolt-invoke (var-deref "clojure.core" "nil?") op)) jolt-nil (if (jolt-truthy? (let* ((and__13__auto arity-ok)) (if (jolt-truthy? and__13__auto) (jolt-not (jolt-invoke arity-ok nargs)) and__13__auto))) jolt-nil (if (jolt-truthy? (keyword #f "else")) op jolt-nil)))))))) native-op))) + (def-var! "jolt.backend-scheme" "emit-fn" (letrec ((emit-fn (lambda (node) (let fnrec4179 ((node node)) (let* ((arities (jolt-get node (keyword #f "arities"))) (self (let* ((temp__15__auto (jolt-get node (keyword #f "name")))) (if (jolt-truthy? temp__15__auto) (let* ((nm temp__15__auto)) (jolt-invoke (var-deref "jolt.backend-scheme" "munge-name") nm)) jolt-nil))) (clauses (let* ((frame__8__auto (jolt-invoke (var-deref "clojure.core" "array-map") (jolt-var "jolt.backend-scheme" "*known-procs*") (if (jolt-truthy? self) (jolt-conj (var-deref "jolt.backend-scheme" "*known-procs*") self) (var-deref "jolt.backend-scheme" "*known-procs*"))))) (begin (jolt-invoke (var-deref "clojure.core" "push-thread-bindings") frame__8__auto) (dynamic-wind (lambda () #f) (lambda () (jolt-invoke (var-deref "clojure.core" "mapv") (var-deref "jolt.backend-scheme" "emit-arity-clause") arities)) (lambda () (jolt-invoke (var-deref "clojure.core" "pop-thread-bindings"))))))) (_lambda (if (jolt= 1 (jolt-count clauses)) (let* ((c (jolt-first clauses))) (let* ((_a$4180 (var-deref "clojure.core" "str")) (_a$4181 "(lambda ") (_a$4182 (jolt-nth c 0)) (_a$4183 " ") (_a$4184 (jolt-nth c 1)) (_a$4185 ")")) (jolt-invoke _a$4180 _a$4181 _a$4182 _a$4183 _a$4184 _a$4185))) (jolt-invoke (var-deref "clojure.core" "str") "(case-lambda " (jolt-invoke (var-deref "clojure.string" "join") " " (jolt-map (lambda (c) (let fnrec4186 ((c c)) (let* ((_a$4187 (var-deref "clojure.core" "str")) (_a$4188 "(") (_a$4189 (jolt-nth c 0)) (_a$4190 " ") (_a$4191 (jolt-nth c 1)) (_a$4192 ")")) (jolt-invoke _a$4187 _a$4188 _a$4189 _a$4190 _a$4191 _a$4192)))) clauses)) ")")))) (let* ((temp__4__auto (jolt-get node (keyword #f "name")))) (if (jolt-truthy? temp__4__auto) (let* ((nm temp__4__auto)) (let* ((m (jolt-invoke (var-deref "jolt.backend-scheme" "munge-name") nm))) (jolt-invoke (var-deref "clojure.core" "str") "(letrec ((" m " " _lambda ")) " m ")"))) _lambda))))))) emit-fn))) (guard (e (#t #f)) - (def-var! "jolt.backend-scheme" "ifn-kind" (letrec ((ifn-kind (lambda (fnode) (let fnrec4184 ((fnode fnode)) (let* ((G__35 (jolt-get fnode (keyword #f "op")))) (if (jolt= G__35 (keyword #f "const")) (if (jolt-truthy? (jolt-invoke (var-deref "clojure.core" "keyword?") (jolt-get fnode (keyword #f "val")))) (keyword #f "keyword") jolt-nil) (if (jolt-truthy? (let* ((or__14__auto (jolt= G__35 (keyword #f "map")))) (if (jolt-truthy? or__14__auto) or__14__auto (let* ((or__14__auto (jolt= G__35 (keyword #f "set")))) (if (jolt-truthy? or__14__auto) or__14__auto (jolt= G__35 (keyword #f "vector"))))))) (keyword #f "coll") jolt-nil))))))) ifn-kind))) + (def-var! "jolt.backend-scheme" "native-op" (letrec ((native-op (lambda (fnode nargs) (let fnrec4193 ((fnode fnode) (nargs nargs)) (let* ((nm (let* ((G__34 (jolt-get fnode (keyword #f "op")))) (if (jolt= G__34 (keyword #f "var")) (if (jolt= "clojure.core" (jolt-get fnode (keyword #f "ns"))) (jolt-get fnode (keyword #f "name")) jolt-nil) (if (jolt= G__34 (keyword #f "host")) (jolt-get fnode (keyword #f "name")) jolt-nil)))) (op (if (jolt-truthy? nm) (jolt-invoke (var-deref "jolt.backend-scheme" "native-ops") nm) jolt-nil)) (arity-ok (if (jolt-truthy? nm) (jolt-invoke (var-deref "jolt.backend-scheme" "op-arity") nm) jolt-nil))) (if (jolt-truthy? (jolt-invoke (var-deref "clojure.core" "nil?") op)) jolt-nil (if (jolt-truthy? (let* ((and__13__auto arity-ok)) (if (jolt-truthy? and__13__auto) (jolt-not (jolt-invoke arity-ok nargs)) and__13__auto))) jolt-nil (if (jolt-truthy? (keyword #f "else")) op jolt-nil)))))))) native-op))) (guard (e (#t #f)) - (def-var! "jolt.backend-scheme" "stdlib-var?" (letrec ((stdlib-var? (lambda (n) (let fnrec4185 ((n n)) (let* ((and__13__auto (jolt= (keyword #f "var") (jolt-get n (keyword #f "op"))))) (if (jolt-truthy? and__13__auto) (jolt-invoke (var-deref "clojure.string" "starts-with?") (let* ((or__14__auto (jolt-get n (keyword #f "ns")))) (if (jolt-truthy? or__14__auto) or__14__auto "")) "clojure.") and__13__auto)))))) stdlib-var?))) + (def-var! "jolt.backend-scheme" "ifn-kind" (letrec ((ifn-kind (lambda (fnode) (let fnrec4194 ((fnode fnode)) (let* ((G__35 (jolt-get fnode (keyword #f "op")))) (if (jolt= G__35 (keyword #f "const")) (if (jolt-truthy? (jolt-invoke (var-deref "clojure.core" "keyword?") (jolt-get fnode (keyword #f "val")))) (keyword #f "keyword") jolt-nil) (if (jolt-truthy? (let* ((or__14__auto (jolt= G__35 (keyword #f "map")))) (if (jolt-truthy? or__14__auto) or__14__auto (let* ((or__14__auto (jolt= G__35 (keyword #f "set")))) (if (jolt-truthy? or__14__auto) or__14__auto (jolt= G__35 (keyword #f "vector"))))))) (keyword #f "coll") jolt-nil))))))) ifn-kind))) (guard (e (#t #f)) - (def-var! "jolt.backend-scheme" "emit-invoke" (letrec ((emit-invoke (lambda (node) (let fnrec4186 ((node node)) (let* ((fnode (jolt-get node (keyword #f "fn"))) (arg-nodes (jolt-get node (keyword #f "args"))) (args (jolt-invoke (var-deref "clojure.core" "mapv") (var-deref "jolt.backend-scheme" "emit") arg-nodes)) (nop (jolt-invoke (var-deref "jolt.backend-scheme" "native-op") fnode (jolt-count args))) (kind (jolt-invoke (var-deref "jolt.backend-scheme" "ifn-kind") fnode)) (order-args (lambda (build) (let fnrec4187 ((build build)) (jolt-invoke (var-deref "jolt.backend-scheme" "ordered-call") arg-nodes args build)))) (defstr (lambda (as) (let fnrec4188 ((as as)) (if (> (jolt-count as) 1) (jolt-invoke (var-deref "clojure.core" "str") " " (jolt-nth as 1)) "")))) (invoke (lambda () (let fnrec4189 () (let* ((_a$4191 (var-deref "jolt.backend-scheme" "ordered-call")) (_a$4192 (jolt-cons fnode arg-nodes)) (_a$4193 (jolt-cons (jolt-invoke (var-deref "jolt.backend-scheme" "emit") fnode) args)) (_a$4194 (lambda (G__36) (let fnrec4190 ((G__36 G__36)) (let* ((G__37 G__36) (f (jolt-nth G__37 0 jolt-nil)) (as (jolt-invoke (var-deref "clojure.core" "nthnext") G__37 1))) (jolt-invoke (var-deref "clojure.core" "str") "(jolt-invoke " f (if (jolt-truthy? (jolt-seq as)) (jolt-invoke (var-deref "clojure.core" "str") " " (jolt-invoke (var-deref "clojure.string" "join") " " as)) "") ")")))))) (jolt-invoke _a$4191 _a$4192 _a$4193 _a$4194)))))) (if (jolt-truthy? (let* ((and__13__auto nop)) (if (jolt-truthy? and__13__auto) (let* ((and__13__auto (jolt-empty? args))) (if (jolt-truthy? and__13__auto) (jolt= nop "+") and__13__auto)) and__13__auto))) "0" (if (jolt-truthy? (let* ((and__13__auto nop)) (if (jolt-truthy? and__13__auto) (let* ((and__13__auto (jolt-empty? args))) (if (jolt-truthy? and__13__auto) (jolt= nop "*") and__13__auto)) and__13__auto))) "1" (if (jolt-truthy? (let* ((and__13__auto nop)) (if (jolt-truthy? and__13__auto) (let* ((and__13__auto (jolt= 1 (jolt-count args)))) (if (jolt-truthy? and__13__auto) (jolt-invoke (var-deref "jolt.backend-scheme" "cmp1-ops") nop) and__13__auto)) and__13__auto))) (jolt-invoke (var-deref "clojure.core" "str") "(begin " (jolt-first args) " #t)") (if (jolt-truthy? nop) (jolt-invoke order-args (lambda (as) (let fnrec4195 ((as as)) (jolt-invoke (var-deref "clojure.core" "str") "(" nop " " (jolt-invoke (var-deref "clojure.string" "join") " " as) ")")))) (if (jolt= kind (keyword #f "keyword")) (jolt-invoke order-args (lambda (as) (let fnrec4196 ((as as)) (let* ((_a$4197 (var-deref "clojure.core" "str")) (_a$4198 "(jolt-get ") (_a$4199 (jolt-first as)) (_a$4200 " ") (_a$4201 (jolt-invoke (var-deref "jolt.backend-scheme" "emit") fnode)) (_a$4202 (jolt-invoke defstr as)) (_a$4203 ")")) (jolt-invoke _a$4197 _a$4198 _a$4199 _a$4200 _a$4201 _a$4202 _a$4203))))) (if (jolt= kind (keyword #f "coll")) (let* ((_a$4205 (var-deref "jolt.backend-scheme" "ordered-call")) (_a$4206 (jolt-cons fnode arg-nodes)) (_a$4207 (jolt-cons (jolt-invoke (var-deref "jolt.backend-scheme" "emit") fnode) args)) (_a$4208 (lambda (G__38) (let fnrec4204 ((G__38 G__38)) (let* ((G__39 G__38) (c (jolt-nth G__39 0 jolt-nil)) (as (jolt-invoke (var-deref "clojure.core" "nthnext") G__39 1))) (jolt-invoke (var-deref "clojure.core" "str") "(jolt-get " c " " (jolt-invoke (var-deref "clojure.string" "join") " " as) ")")))))) (jolt-invoke _a$4205 _a$4206 _a$4207 _a$4208)) (if (jolt-truthy? (let* ((and__13__auto (jolt-invoke (var-deref "jolt.backend-scheme" "stdlib-var?") fnode))) (if (jolt-truthy? and__13__auto) (jolt-not (jolt-invoke (var-deref "clojure.core" "deref") (var-deref "jolt.backend-scheme" "prelude-mode?"))) and__13__auto))) (jolt-throw (let* ((_a$4215 (let* ((_a$4209 (var-deref "clojure.core" "str")) (_a$4210 "emit: unsupported stdlib fn `") (_a$4211 (jolt-get fnode (keyword #f "ns"))) (_a$4212 "/") (_a$4213 (jolt-get fnode (keyword #f "name"))) (_a$4214 "` (no core on Chez yet)")) (jolt-invoke _a$4209 _a$4210 _a$4211 _a$4212 _a$4213 _a$4214))) (_a$4216 (jolt-hash-map))) (jolt-ex-info _a$4215 _a$4216))) (if (jolt= (keyword #f "host-static") (jolt-get fnode (keyword #f "op"))) (jolt-invoke order-args (lambda (as) (let fnrec4217 ((as as)) (let* ((_a$4218 (var-deref "clojure.core" "str")) (_a$4219 "(host-static-call ") (_a$4220 (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") (jolt-get fnode (keyword #f "class")))) (_a$4221 " ") (_a$4222 (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") (jolt-get fnode (keyword #f "member")))) (_a$4223 (if (jolt-empty? as) "" (jolt-invoke (var-deref "clojure.core" "str") " " (jolt-invoke (var-deref "clojure.string" "join") " " as)))) (_a$4224 ")")) (jolt-invoke _a$4218 _a$4219 _a$4220 _a$4221 _a$4222 _a$4223 _a$4224))))) (if (jolt= (keyword #f "host") (jolt-get fnode (keyword #f "op"))) (jolt-throw (let* ((_a$4225 (jolt-invoke (var-deref "clojure.core" "str") "emit: unsupported host call `" (jolt-get fnode (keyword #f "name")) "`")) (_a$4226 (jolt-hash-map))) (jolt-ex-info _a$4225 _a$4226))) (if (jolt-truthy? (let* ((and__13__auto (jolt= (keyword #f "local") (jolt-get fnode (keyword #f "op"))))) (if (jolt-truthy? and__13__auto) (jolt-not (jolt-invoke (var-deref "jolt.backend-scheme" "*known-procs*") (jolt-invoke (var-deref "jolt.backend-scheme" "munge-name") (jolt-get fnode (keyword #f "name"))))) and__13__auto))) (jolt-invoke invoke) (if (jolt= (keyword #f "var") (jolt-get fnode (keyword #f "op"))) (jolt-invoke invoke) (if (jolt-truthy? (keyword #f "else")) (jolt-invoke invoke) jolt-nil))))))))))))))))) emit-invoke))) + (def-var! "jolt.backend-scheme" "stdlib-var?" (letrec ((stdlib-var? (lambda (n) (let fnrec4195 ((n n)) (let* ((and__13__auto (jolt= (keyword #f "var") (jolt-get n (keyword #f "op"))))) (if (jolt-truthy? and__13__auto) (jolt-invoke (var-deref "clojure.string" "starts-with?") (let* ((or__14__auto (jolt-get n (keyword #f "ns")))) (if (jolt-truthy? or__14__auto) or__14__auto "")) "clojure.") and__13__auto)))))) stdlib-var?))) (guard (e (#t #f)) - (def-var! "jolt.backend-scheme" "emit-try" (letrec ((emit-try (lambda (node) (let fnrec4227 ((node node)) (let* ((core (let* ((temp__4__auto (jolt-get node (keyword #f "catch-sym")))) (if (jolt-truthy? temp__4__auto) (let* ((cs temp__4__auto)) (let* ((_a$4228 (var-deref "clojure.core" "str")) (_a$4229 "(guard (") (_a$4230 (jolt-invoke (var-deref "jolt.backend-scheme" "munge-name") cs)) (_a$4231 " (else ") (_a$4232 (jolt-invoke (var-deref "jolt.backend-scheme" "emit") (jolt-get node (keyword #f "catch-body")))) (_a$4233 ")) ") (_a$4234 (jolt-invoke (var-deref "jolt.backend-scheme" "emit") (jolt-get node (keyword #f "body")))) (_a$4235 ")")) (jolt-invoke _a$4228 _a$4229 _a$4230 _a$4231 _a$4232 _a$4233 _a$4234 _a$4235))) (jolt-invoke (var-deref "jolt.backend-scheme" "emit") (jolt-get node (keyword #f "body"))))))) (let* ((temp__4__auto (jolt-get node (keyword #f "finally")))) (if (jolt-truthy? temp__4__auto) (let* ((fin temp__4__auto)) (jolt-invoke (var-deref "clojure.core" "str") "(dynamic-wind (lambda () #f) (lambda () " core ") (lambda () " (jolt-invoke (var-deref "jolt.backend-scheme" "emit") fin) "))")) core))))))) emit-try))) + (def-var! "jolt.backend-scheme" "emit-invoke" (letrec ((emit-invoke (lambda (node) (let fnrec4196 ((node node)) (let* ((fnode (jolt-get node (keyword #f "fn"))) (arg-nodes (jolt-get node (keyword #f "args"))) (args (jolt-invoke (var-deref "clojure.core" "mapv") (var-deref "jolt.backend-scheme" "emit") arg-nodes)) (nop (jolt-invoke (var-deref "jolt.backend-scheme" "native-op") fnode (jolt-count args))) (kind (jolt-invoke (var-deref "jolt.backend-scheme" "ifn-kind") fnode)) (order-args (lambda (build) (let fnrec4197 ((build build)) (jolt-invoke (var-deref "jolt.backend-scheme" "ordered-call") arg-nodes args build)))) (defstr (lambda (as) (let fnrec4198 ((as as)) (if (> (jolt-count as) 1) (jolt-invoke (var-deref "clojure.core" "str") " " (jolt-nth as 1)) "")))) (invoke (lambda () (let fnrec4199 () (let* ((_a$4201 (var-deref "jolt.backend-scheme" "ordered-call")) (_a$4202 (jolt-cons fnode arg-nodes)) (_a$4203 (jolt-cons (jolt-invoke (var-deref "jolt.backend-scheme" "emit") fnode) args)) (_a$4204 (lambda (G__36) (let fnrec4200 ((G__36 G__36)) (let* ((G__37 G__36) (f (jolt-nth G__37 0 jolt-nil)) (as (jolt-invoke (var-deref "clojure.core" "nthnext") G__37 1))) (jolt-invoke (var-deref "clojure.core" "str") "(jolt-invoke " f (if (jolt-truthy? (jolt-seq as)) (jolt-invoke (var-deref "clojure.core" "str") " " (jolt-invoke (var-deref "clojure.string" "join") " " as)) "") ")")))))) (jolt-invoke _a$4201 _a$4202 _a$4203 _a$4204)))))) (if (jolt-truthy? (let* ((and__13__auto nop)) (if (jolt-truthy? and__13__auto) (let* ((and__13__auto (jolt-empty? args))) (if (jolt-truthy? and__13__auto) (jolt= nop "+") and__13__auto)) and__13__auto))) "0" (if (jolt-truthy? (let* ((and__13__auto nop)) (if (jolt-truthy? and__13__auto) (let* ((and__13__auto (jolt-empty? args))) (if (jolt-truthy? and__13__auto) (jolt= nop "*") and__13__auto)) and__13__auto))) "1" (if (jolt-truthy? (let* ((and__13__auto nop)) (if (jolt-truthy? and__13__auto) (let* ((and__13__auto (jolt= 1 (jolt-count args)))) (if (jolt-truthy? and__13__auto) (jolt-invoke (var-deref "jolt.backend-scheme" "cmp1-ops") nop) and__13__auto)) and__13__auto))) (jolt-invoke (var-deref "clojure.core" "str") "(begin " (jolt-first args) " #t)") (if (jolt-truthy? nop) (jolt-invoke order-args (lambda (as) (let fnrec4205 ((as as)) (jolt-invoke (var-deref "clojure.core" "str") "(" nop " " (jolt-invoke (var-deref "clojure.string" "join") " " as) ")")))) (if (jolt= kind (keyword #f "keyword")) (jolt-invoke order-args (lambda (as) (let fnrec4206 ((as as)) (let* ((_a$4207 (var-deref "clojure.core" "str")) (_a$4208 "(jolt-get ") (_a$4209 (jolt-first as)) (_a$4210 " ") (_a$4211 (jolt-invoke (var-deref "jolt.backend-scheme" "emit") fnode)) (_a$4212 (jolt-invoke defstr as)) (_a$4213 ")")) (jolt-invoke _a$4207 _a$4208 _a$4209 _a$4210 _a$4211 _a$4212 _a$4213))))) (if (jolt= kind (keyword #f "coll")) (let* ((_a$4215 (var-deref "jolt.backend-scheme" "ordered-call")) (_a$4216 (jolt-cons fnode arg-nodes)) (_a$4217 (jolt-cons (jolt-invoke (var-deref "jolt.backend-scheme" "emit") fnode) args)) (_a$4218 (lambda (G__38) (let fnrec4214 ((G__38 G__38)) (let* ((G__39 G__38) (c (jolt-nth G__39 0 jolt-nil)) (as (jolt-invoke (var-deref "clojure.core" "nthnext") G__39 1))) (jolt-invoke (var-deref "clojure.core" "str") "(jolt-get " c " " (jolt-invoke (var-deref "clojure.string" "join") " " as) ")")))))) (jolt-invoke _a$4215 _a$4216 _a$4217 _a$4218)) (if (jolt-truthy? (let* ((and__13__auto (jolt-invoke (var-deref "jolt.backend-scheme" "stdlib-var?") fnode))) (if (jolt-truthy? and__13__auto) (jolt-not (jolt-invoke (var-deref "clojure.core" "deref") (var-deref "jolt.backend-scheme" "prelude-mode?"))) and__13__auto))) (jolt-throw (let* ((_a$4225 (let* ((_a$4219 (var-deref "clojure.core" "str")) (_a$4220 "emit: unsupported stdlib fn `") (_a$4221 (jolt-get fnode (keyword #f "ns"))) (_a$4222 "/") (_a$4223 (jolt-get fnode (keyword #f "name"))) (_a$4224 "` (no core on Chez yet)")) (jolt-invoke _a$4219 _a$4220 _a$4221 _a$4222 _a$4223 _a$4224))) (_a$4226 (jolt-hash-map))) (jolt-ex-info _a$4225 _a$4226))) (if (jolt= (keyword #f "host-static") (jolt-get fnode (keyword #f "op"))) (jolt-invoke order-args (lambda (as) (let fnrec4227 ((as as)) (let* ((_a$4228 (var-deref "clojure.core" "str")) (_a$4229 "(host-static-call ") (_a$4230 (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") (jolt-get fnode (keyword #f "class")))) (_a$4231 " ") (_a$4232 (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") (jolt-get fnode (keyword #f "member")))) (_a$4233 (if (jolt-empty? as) "" (jolt-invoke (var-deref "clojure.core" "str") " " (jolt-invoke (var-deref "clojure.string" "join") " " as)))) (_a$4234 ")")) (jolt-invoke _a$4228 _a$4229 _a$4230 _a$4231 _a$4232 _a$4233 _a$4234))))) (if (jolt= (keyword #f "host") (jolt-get fnode (keyword #f "op"))) (jolt-throw (let* ((_a$4235 (jolt-invoke (var-deref "clojure.core" "str") "emit: unsupported host call `" (jolt-get fnode (keyword #f "name")) "`")) (_a$4236 (jolt-hash-map))) (jolt-ex-info _a$4235 _a$4236))) (if (jolt-truthy? (let* ((and__13__auto (jolt= (keyword #f "local") (jolt-get fnode (keyword #f "op"))))) (if (jolt-truthy? and__13__auto) (jolt-not (jolt-invoke (var-deref "jolt.backend-scheme" "*known-procs*") (jolt-invoke (var-deref "jolt.backend-scheme" "munge-name") (jolt-get fnode (keyword #f "name"))))) and__13__auto))) (jolt-invoke invoke) (if (jolt= (keyword #f "var") (jolt-get fnode (keyword #f "op"))) (jolt-invoke invoke) (if (jolt-truthy? (keyword #f "else")) (jolt-invoke invoke) jolt-nil))))))))))))))))) emit-invoke))) (guard (e (#t #f)) - (def-var! "jolt.backend-scheme" "returns-scheme-bool?" (letrec ((returns-scheme-bool? (lambda (node) (let fnrec4236 ((node node)) (if (jolt-truthy? (let* ((and__13__auto (jolt= (keyword #f "const") (jolt-get node (keyword #f "op"))))) (if (jolt-truthy? and__13__auto) (jolt-invoke (var-deref "clojure.core" "boolean?") (jolt-get node (keyword #f "val"))) and__13__auto))) #t (if (jolt= (keyword #f "invoke") (jolt-get node (keyword #f "op"))) (let* ((nop (let* ((_a$4237 (var-deref "jolt.backend-scheme" "native-op")) (_a$4238 (jolt-get node (keyword #f "fn"))) (_a$4239 (jolt-count (jolt-get node (keyword #f "args"))))) (jolt-invoke _a$4237 _a$4238 _a$4239)))) (if (jolt-truthy? (let* ((and__13__auto nop)) (if (jolt-truthy? and__13__auto) (jolt-invoke (var-deref "jolt.backend-scheme" "bool-returning-ops") nop) and__13__auto))) #t #f)) (if (jolt-truthy? (keyword #f "else")) #f jolt-nil))))))) returns-scheme-bool?))) + (def-var! "jolt.backend-scheme" "emit-try" (letrec ((emit-try (lambda (node) (let fnrec4237 ((node node)) (let* ((core (let* ((temp__4__auto (jolt-get node (keyword #f "catch-sym")))) (if (jolt-truthy? temp__4__auto) (let* ((cs temp__4__auto)) (let* ((_a$4238 (var-deref "clojure.core" "str")) (_a$4239 "(guard (") (_a$4240 (jolt-invoke (var-deref "jolt.backend-scheme" "munge-name") cs)) (_a$4241 " (else ") (_a$4242 (jolt-invoke (var-deref "jolt.backend-scheme" "emit") (jolt-get node (keyword #f "catch-body")))) (_a$4243 ")) ") (_a$4244 (jolt-invoke (var-deref "jolt.backend-scheme" "emit") (jolt-get node (keyword #f "body")))) (_a$4245 ")")) (jolt-invoke _a$4238 _a$4239 _a$4240 _a$4241 _a$4242 _a$4243 _a$4244 _a$4245))) (jolt-invoke (var-deref "jolt.backend-scheme" "emit") (jolt-get node (keyword #f "body"))))))) (let* ((temp__4__auto (jolt-get node (keyword #f "finally")))) (if (jolt-truthy? temp__4__auto) (let* ((fin temp__4__auto)) (jolt-invoke (var-deref "clojure.core" "str") "(dynamic-wind (lambda () #f) (lambda () " core ") (lambda () " (jolt-invoke (var-deref "jolt.backend-scheme" "emit") fin) "))")) core))))))) emit-try))) (guard (e (#t #f)) - (def-var! "jolt.backend-scheme" "emit" (letrec ((emit (lambda (node) (let fnrec4240 ((node node)) (let* ((G__40 (jolt-get node (keyword #f "op")))) (if (jolt= G__40 (keyword #f "const")) (jolt-invoke (var-deref "jolt.backend-scheme" "emit-const") (jolt-get node (keyword #f "val"))) (if (jolt= G__40 (keyword #f "local")) (jolt-invoke (var-deref "jolt.backend-scheme" "munge-name") (jolt-get node (keyword #f "name"))) (if (jolt= G__40 (keyword #f "var")) (let* ((core-proc (let* ((and__13__auto (jolt= "clojure.core" (jolt-get node (keyword #f "ns"))))) (if (jolt-truthy? and__13__auto) (jolt-invoke (var-deref "jolt.backend-scheme" "core-value-procs") (jolt-get node (keyword #f "name"))) and__13__auto)))) (if (jolt-truthy? core-proc) core-proc (if (jolt-truthy? (let* ((and__13__auto (jolt-invoke (var-deref "jolt.backend-scheme" "stdlib-var?") node))) (if (jolt-truthy? and__13__auto) (jolt-not (jolt-invoke (var-deref "clojure.core" "deref") (var-deref "jolt.backend-scheme" "prelude-mode?"))) and__13__auto))) (jolt-throw (let* ((_a$4247 (let* ((_a$4241 (var-deref "clojure.core" "str")) (_a$4242 "emit: unsupported stdlib ref `") (_a$4243 (jolt-get node (keyword #f "ns"))) (_a$4244 "/") (_a$4245 (jolt-get node (keyword #f "name"))) (_a$4246 "` (no core on Chez yet)")) (jolt-invoke _a$4241 _a$4242 _a$4243 _a$4244 _a$4245 _a$4246))) (_a$4248 (jolt-hash-map))) (jolt-ex-info _a$4247 _a$4248))) (if (jolt-truthy? (keyword #f "else")) (let* ((_a$4249 (var-deref "clojure.core" "str")) (_a$4250 "(var-deref ") (_a$4251 (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") (jolt-get node (keyword #f "ns")))) (_a$4252 " ") (_a$4253 (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") (jolt-get node (keyword #f "name")))) (_a$4254 ")")) (jolt-invoke _a$4249 _a$4250 _a$4251 _a$4252 _a$4253 _a$4254)) jolt-nil)))) (if (jolt= G__40 (keyword #f "the-var")) (let* ((_a$4255 (var-deref "clojure.core" "str")) (_a$4256 "(jolt-var ") (_a$4257 (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") (jolt-get node (keyword #f "ns")))) (_a$4258 " ") (_a$4259 (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") (jolt-get node (keyword #f "name")))) (_a$4260 ")")) (jolt-invoke _a$4255 _a$4256 _a$4257 _a$4258 _a$4259 _a$4260)) (if (jolt= G__40 (keyword #f "set-var")) (let* ((_a$4261 (var-deref "clojure.core" "str")) (_a$4262 "(jolt-var-set ") (_a$4263 (jolt-invoke emit (jolt-get node (keyword #f "the-var")))) (_a$4264 " ") (_a$4265 (jolt-invoke emit (jolt-get node (keyword #f "val")))) (_a$4266 ")")) (jolt-invoke _a$4261 _a$4262 _a$4263 _a$4264 _a$4265 _a$4266)) (if (jolt= G__40 (keyword #f "set-field")) (let* ((_a$4267 (var-deref "clojure.core" "str")) (_a$4268 "(jolt-set-field! ") (_a$4269 (jolt-invoke emit (jolt-get node (keyword #f "obj")))) (_a$4270 " (keyword #f ") (_a$4271 (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") (jolt-get node (keyword #f "field")))) (_a$4272 ") ") (_a$4273 (jolt-invoke emit (jolt-get node (keyword #f "val")))) (_a$4274 ")")) (jolt-invoke _a$4267 _a$4268 _a$4269 _a$4270 _a$4271 _a$4272 _a$4273 _a$4274)) (if (jolt= G__40 (keyword #f "defmacro")) (let* ((_a$4275 (var-deref "clojure.core" "str")) (_a$4276 "(begin (def-var! ") (_a$4277 (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") (jolt-get node (keyword #f "ns")))) (_a$4278 " ") (_a$4279 (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") (jolt-get node (keyword #f "name")))) (_a$4280 " ") (_a$4281 (jolt-invoke emit (jolt-get node (keyword #f "fn")))) (_a$4282 ") (mark-macro! ") (_a$4283 (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") (jolt-get node (keyword #f "ns")))) (_a$4284 " ") (_a$4285 (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") (jolt-get node (keyword #f "name")))) (_a$4286 ") jolt-nil)")) (jolt-invoke _a$4275 _a$4276 _a$4277 _a$4278 _a$4279 _a$4280 _a$4281 _a$4282 _a$4283 _a$4284 _a$4285 _a$4286)) (if (jolt= G__40 (keyword #f "host")) (jolt-throw (let* ((_a$4287 (jolt-invoke (var-deref "clojure.core" "str") "emit: unsupported host ref `" (jolt-get node (keyword #f "name")) "`")) (_a$4288 (jolt-hash-map))) (jolt-ex-info _a$4287 _a$4288))) (if (jolt= G__40 (keyword #f "host-static")) (let* ((_a$4289 (var-deref "clojure.core" "str")) (_a$4290 "(host-static-ref ") (_a$4291 (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") (jolt-get node (keyword #f "class")))) (_a$4292 " ") (_a$4293 (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") (jolt-get node (keyword #f "member")))) (_a$4294 ")")) (jolt-invoke _a$4289 _a$4290 _a$4291 _a$4292 _a$4293 _a$4294)) (if (jolt= G__40 (keyword #f "host-new")) (let* ((_a$4295 (var-deref "clojure.core" "str")) (_a$4296 "(host-new ") (_a$4297 (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") (jolt-get node (keyword #f "class")))) (_a$4298 (let* ((args (jolt-map emit (jolt-get node (keyword #f "args"))))) (if (jolt-empty? args) "" (jolt-invoke (var-deref "clojure.core" "str") " " (jolt-invoke (var-deref "clojure.string" "join") " " args))))) (_a$4299 ")")) (jolt-invoke _a$4295 _a$4296 _a$4297 _a$4298 _a$4299)) (if (jolt= G__40 (keyword #f "if")) (let* ((test (jolt-get node (keyword #f "test"))) (t (if (jolt-truthy? (jolt-invoke (var-deref "jolt.backend-scheme" "returns-scheme-bool?") test)) (jolt-invoke emit test) (jolt-invoke (var-deref "clojure.core" "str") "(jolt-truthy? " (jolt-invoke emit test) ")")))) (let* ((_a$4300 (var-deref "clojure.core" "str")) (_a$4301 "(if ") (_a$4302 t) (_a$4303 " ") (_a$4304 (jolt-invoke emit (jolt-get node (keyword #f "then")))) (_a$4305 " ") (_a$4306 (jolt-invoke emit (jolt-get node (keyword #f "else")))) (_a$4307 ")")) (jolt-invoke _a$4300 _a$4301 _a$4302 _a$4303 _a$4304 _a$4305 _a$4306 _a$4307))) (if (jolt= G__40 (keyword #f "do")) (let* ((_a$4308 (var-deref "clojure.core" "str")) (_a$4309 "(begin ") (_a$4310 (jolt-invoke (var-deref "clojure.string" "join") " " (jolt-map emit (jolt-get node (keyword #f "statements"))))) (_a$4311 (if (jolt-empty? (jolt-get node (keyword #f "statements"))) "" " ")) (_a$4312 (jolt-invoke emit (jolt-get node (keyword #f "ret")))) (_a$4313 ")")) (jolt-invoke _a$4308 _a$4309 _a$4310 _a$4311 _a$4312 _a$4313)) (if (jolt= G__40 (keyword #f "invoke")) (jolt-invoke (var-deref "jolt.backend-scheme" "emit-invoke") node) (if (jolt= G__40 (keyword #f "vector")) (jolt-invoke (var-deref "jolt.backend-scheme" "emit-ordered") "jolt-vector" (jolt-map emit (jolt-get node (keyword #f "items")))) (if (jolt= G__40 (keyword #f "set")) (jolt-invoke (var-deref "jolt.backend-scheme" "emit-ordered") "jolt-hash-set" (jolt-map emit (jolt-get node (keyword #f "items")))) (if (jolt= G__40 (keyword #f "map")) (jolt-invoke (var-deref "jolt.backend-scheme" "emit-ordered") "jolt-hash-map" (let* ((_a$4317 (var-deref "clojure.core" "mapcat")) (_a$4318 (lambda (p) (let fnrec4314 ((p p)) (let* ((_o$4315 (jolt-invoke emit (jolt-nth p 0))) (_o$4316 (jolt-invoke emit (jolt-nth p 1)))) (jolt-vector _o$4315 _o$4316))))) (_a$4319 (jolt-get node (keyword #f "pairs")))) (jolt-invoke _a$4317 _a$4318 _a$4319))) (if (jolt= G__40 (keyword #f "quote")) (jolt-invoke (var-deref "jolt.backend-scheme" "emit-quoted") (jolt-get node (keyword #f "form"))) (if (jolt= G__40 (keyword #f "throw")) (jolt-invoke (var-deref "clojure.core" "str") "(jolt-throw " (jolt-invoke emit (jolt-get node (keyword #f "expr"))) ")") (if (jolt= G__40 (keyword #f "try")) (jolt-invoke (var-deref "jolt.backend-scheme" "emit-try") node) (if (jolt= G__40 (keyword #f "regex")) (jolt-invoke (var-deref "clojure.core" "str") "(jolt-regex " (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") (jolt-get node (keyword #f "source"))) ")") (if (jolt= G__40 (keyword #f "inst")) (jolt-invoke (var-deref "clojure.core" "str") "(jolt-inst-from-string " (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") (jolt-get node (keyword #f "source"))) ")") (if (jolt= G__40 (keyword #f "uuid")) (jolt-invoke (var-deref "clojure.core" "str") "(jolt-uuid-from-string " (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") (jolt-get node (keyword #f "source"))) ")") (if (jolt= G__40 (keyword #f "bigdec")) (jolt-invoke (var-deref "clojure.core" "str") "(jolt-bigdec-from-string " (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") (jolt-get node (keyword #f "source"))) ")") (if (jolt= G__40 (keyword #f "the-ns")) (jolt-invoke (var-deref "clojure.core" "str") "(intern-ns! " (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") (jolt-get node (keyword #f "name"))) ")") (if (jolt= G__40 (keyword #f "host-call")) (let* ((m (jolt-get node (keyword #f "method"))) (target (jolt-invoke emit (jolt-get node (keyword #f "target")))) (args (jolt-map emit (jolt-get node (keyword #f "args"))))) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.backend-scheme" "supported-host-methods") m)) (let* ((_a$4320 (var-deref "clojure.core" "str")) (_a$4321 "(jolt-host-call ") (_a$4322 (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") m)) (_a$4323 " ") (_a$4324 target) (_a$4325 (if (jolt-empty? args) "" (jolt-invoke (var-deref "clojure.core" "str") " " (jolt-invoke (var-deref "clojure.string" "join") " " args)))) (_a$4326 ")")) (jolt-invoke _a$4320 _a$4321 _a$4322 _a$4323 _a$4324 _a$4325 _a$4326)) (let* ((_a$4327 (var-deref "clojure.core" "str")) (_a$4328 "(record-method-dispatch ") (_a$4329 target) (_a$4330 " ") (_a$4331 (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") m)) (_a$4332 " (jolt-vector") (_a$4333 (if (jolt-empty? args) "" (jolt-invoke (var-deref "clojure.core" "str") " " (jolt-invoke (var-deref "clojure.string" "join") " " args)))) (_a$4334 "))")) (jolt-invoke _a$4327 _a$4328 _a$4329 _a$4330 _a$4331 _a$4332 _a$4333 _a$4334)))) (if (jolt= G__40 (keyword #f "let")) (jolt-invoke (var-deref "jolt.backend-scheme" "emit-let") node) (if (jolt= G__40 (keyword #f "loop")) (jolt-invoke (var-deref "jolt.backend-scheme" "emit-loop") node) (if (jolt= G__40 (keyword #f "recur")) (jolt-invoke (var-deref "jolt.backend-scheme" "emit-recur") node) (if (jolt= G__40 (keyword #f "ffi-fn")) (jolt-invoke (var-deref "jolt.backend-scheme" "emit-ffi-fn") node) (if (jolt= G__40 (keyword #f "fn")) (jolt-invoke (var-deref "jolt.backend-scheme" "emit-fn") node) (if (jolt= G__40 (keyword #f "def")) (if (jolt-truthy? (jolt-get node (keyword #f "no-init"))) (let* ((_a$4335 (var-deref "clojure.core" "str")) (_a$4336 "(declare-var! ") (_a$4337 (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") (jolt-get node (keyword #f "ns")))) (_a$4338 " ") (_a$4339 (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") (jolt-get node (keyword #f "name")))) (_a$4340 ")")) (jolt-invoke _a$4335 _a$4336 _a$4337 _a$4338 _a$4339 _a$4340)) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.backend-scheme" "jmeta-nonempty?") (jolt-get node (keyword #f "meta")))) (let* ((_a$4341 (var-deref "clojure.core" "str")) (_a$4342 "(def-var-with-meta! ") (_a$4343 (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") (jolt-get node (keyword #f "ns")))) (_a$4344 " ") (_a$4345 (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") (jolt-get node (keyword #f "name")))) (_a$4346 " ") (_a$4347 (jolt-invoke emit (jolt-get node (keyword #f "init")))) (_a$4348 " ") (_a$4349 (jolt-invoke (var-deref "jolt.backend-scheme" "emit-quoted") (jolt-get node (keyword #f "meta")))) (_a$4350 ")")) (jolt-invoke _a$4341 _a$4342 _a$4343 _a$4344 _a$4345 _a$4346 _a$4347 _a$4348 _a$4349 _a$4350)) (if (jolt-truthy? (keyword #f "else")) (let* ((_a$4351 (var-deref "clojure.core" "str")) (_a$4352 "(def-var! ") (_a$4353 (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") (jolt-get node (keyword #f "ns")))) (_a$4354 " ") (_a$4355 (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") (jolt-get node (keyword #f "name")))) (_a$4356 " ") (_a$4357 (jolt-invoke emit (jolt-get node (keyword #f "init")))) (_a$4358 ")")) (jolt-invoke _a$4351 _a$4352 _a$4353 _a$4354 _a$4355 _a$4356 _a$4357 _a$4358)) jolt-nil))) (jolt-throw (let* ((_a$4359 (jolt-invoke (var-deref "clojure.core" "str") "emit: op not yet ported / unhandled: " (jolt-invoke (var-deref "clojure.core" "pr-str") (jolt-get node (keyword #f "op"))))) (_a$4360 (jolt-hash-map))) (jolt-ex-info _a$4359 _a$4360))))))))))))))))))))))))))))))))))))))) emit))) + (def-var! "jolt.backend-scheme" "returns-scheme-bool?" (letrec ((returns-scheme-bool? (lambda (node) (let fnrec4246 ((node node)) (if (jolt-truthy? (let* ((and__13__auto (jolt= (keyword #f "const") (jolt-get node (keyword #f "op"))))) (if (jolt-truthy? and__13__auto) (jolt-invoke (var-deref "clojure.core" "boolean?") (jolt-get node (keyword #f "val"))) and__13__auto))) #t (if (jolt= (keyword #f "invoke") (jolt-get node (keyword #f "op"))) (let* ((nop (let* ((_a$4247 (var-deref "jolt.backend-scheme" "native-op")) (_a$4248 (jolt-get node (keyword #f "fn"))) (_a$4249 (jolt-count (jolt-get node (keyword #f "args"))))) (jolt-invoke _a$4247 _a$4248 _a$4249)))) (if (jolt-truthy? (let* ((and__13__auto nop)) (if (jolt-truthy? and__13__auto) (jolt-invoke (var-deref "jolt.backend-scheme" "bool-returning-ops") nop) and__13__auto))) #t #f)) (if (jolt-truthy? (keyword #f "else")) #f jolt-nil))))))) returns-scheme-bool?))) (guard (e (#t #f)) - (def-var-with-meta! "jolt.passes.fold" "foldable" (let* ((_o$4361 "+") (_o$4362 jolt-add) (_o$4363 "-") (_o$4364 jolt-sub) (_o$4365 "*") (_o$4366 jolt-mul) (_o$4367 "/") (_o$4368 jolt-div) (_o$4369 "<") (_o$4370 <) (_o$4371 ">") (_o$4372 >) (_o$4373 "<=") (_o$4374 <=) (_o$4375 ">=") (_o$4376 >=) (_o$4377 "=") (_o$4378 jolt=) (_o$4379 "inc") (_o$4380 jolt-inc) (_o$4381 "dec") (_o$4382 jolt-dec) (_o$4383 "mod") (_o$4384 modulo) (_o$4385 "rem") (_o$4386 remainder) (_o$4387 "quot") (_o$4388 quotient) (_o$4389 "bit-and") (_o$4390 (var-deref "clojure.core" "__bit-and")) (_o$4391 "bit-or") (_o$4392 (var-deref "clojure.core" "__bit-or")) (_o$4393 "bit-xor") (_o$4394 (var-deref "clojure.core" "__bit-xor"))) (jolt-hash-map _o$4361 _o$4362 _o$4363 _o$4364 _o$4365 _o$4366 _o$4367 _o$4368 _o$4369 _o$4370 _o$4371 _o$4372 _o$4373 _o$4374 _o$4375 _o$4376 _o$4377 _o$4378 _o$4379 _o$4380 _o$4381 _o$4382 _o$4383 _o$4384 _o$4385 _o$4386 _o$4387 _o$4388 _o$4389 _o$4390 _o$4391 _o$4392 _o$4393 _o$4394)) (jolt-hash-map (keyword #f "private") #t))) + (def-var! "jolt.backend-scheme" "emit" (letrec ((emit (lambda (node) (let fnrec4250 ((node node)) (let* ((G__40 (jolt-get node (keyword #f "op")))) (if (jolt= G__40 (keyword #f "const")) (jolt-invoke (var-deref "jolt.backend-scheme" "emit-const") (jolt-get node (keyword #f "val"))) (if (jolt= G__40 (keyword #f "local")) (jolt-invoke (var-deref "jolt.backend-scheme" "munge-name") (jolt-get node (keyword #f "name"))) (if (jolt= G__40 (keyword #f "var")) (let* ((core-proc (let* ((and__13__auto (jolt= "clojure.core" (jolt-get node (keyword #f "ns"))))) (if (jolt-truthy? and__13__auto) (jolt-invoke (var-deref "jolt.backend-scheme" "core-value-procs") (jolt-get node (keyword #f "name"))) and__13__auto)))) (if (jolt-truthy? core-proc) core-proc (if (jolt-truthy? (let* ((and__13__auto (jolt-invoke (var-deref "jolt.backend-scheme" "stdlib-var?") node))) (if (jolt-truthy? and__13__auto) (jolt-not (jolt-invoke (var-deref "clojure.core" "deref") (var-deref "jolt.backend-scheme" "prelude-mode?"))) and__13__auto))) (jolt-throw (let* ((_a$4257 (let* ((_a$4251 (var-deref "clojure.core" "str")) (_a$4252 "emit: unsupported stdlib ref `") (_a$4253 (jolt-get node (keyword #f "ns"))) (_a$4254 "/") (_a$4255 (jolt-get node (keyword #f "name"))) (_a$4256 "` (no core on Chez yet)")) (jolt-invoke _a$4251 _a$4252 _a$4253 _a$4254 _a$4255 _a$4256))) (_a$4258 (jolt-hash-map))) (jolt-ex-info _a$4257 _a$4258))) (if (jolt-truthy? (keyword #f "else")) (let* ((_a$4259 (var-deref "clojure.core" "str")) (_a$4260 "(var-deref ") (_a$4261 (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") (jolt-get node (keyword #f "ns")))) (_a$4262 " ") (_a$4263 (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") (jolt-get node (keyword #f "name")))) (_a$4264 ")")) (jolt-invoke _a$4259 _a$4260 _a$4261 _a$4262 _a$4263 _a$4264)) jolt-nil)))) (if (jolt= G__40 (keyword #f "the-var")) (let* ((_a$4265 (var-deref "clojure.core" "str")) (_a$4266 "(jolt-var ") (_a$4267 (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") (jolt-get node (keyword #f "ns")))) (_a$4268 " ") (_a$4269 (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") (jolt-get node (keyword #f "name")))) (_a$4270 ")")) (jolt-invoke _a$4265 _a$4266 _a$4267 _a$4268 _a$4269 _a$4270)) (if (jolt= G__40 (keyword #f "set-var")) (let* ((_a$4271 (var-deref "clojure.core" "str")) (_a$4272 "(jolt-var-set ") (_a$4273 (jolt-invoke emit (jolt-get node (keyword #f "the-var")))) (_a$4274 " ") (_a$4275 (jolt-invoke emit (jolt-get node (keyword #f "val")))) (_a$4276 ")")) (jolt-invoke _a$4271 _a$4272 _a$4273 _a$4274 _a$4275 _a$4276)) (if (jolt= G__40 (keyword #f "set-field")) (let* ((_a$4277 (var-deref "clojure.core" "str")) (_a$4278 "(jolt-set-field! ") (_a$4279 (jolt-invoke emit (jolt-get node (keyword #f "obj")))) (_a$4280 " (keyword #f ") (_a$4281 (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") (jolt-get node (keyword #f "field")))) (_a$4282 ") ") (_a$4283 (jolt-invoke emit (jolt-get node (keyword #f "val")))) (_a$4284 ")")) (jolt-invoke _a$4277 _a$4278 _a$4279 _a$4280 _a$4281 _a$4282 _a$4283 _a$4284)) (if (jolt= G__40 (keyword #f "defmacro")) (let* ((_a$4285 (var-deref "clojure.core" "str")) (_a$4286 "(begin (def-var! ") (_a$4287 (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") (jolt-get node (keyword #f "ns")))) (_a$4288 " ") (_a$4289 (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") (jolt-get node (keyword #f "name")))) (_a$4290 " ") (_a$4291 (jolt-invoke emit (jolt-get node (keyword #f "fn")))) (_a$4292 ") (mark-macro! ") (_a$4293 (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") (jolt-get node (keyword #f "ns")))) (_a$4294 " ") (_a$4295 (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") (jolt-get node (keyword #f "name")))) (_a$4296 ") jolt-nil)")) (jolt-invoke _a$4285 _a$4286 _a$4287 _a$4288 _a$4289 _a$4290 _a$4291 _a$4292 _a$4293 _a$4294 _a$4295 _a$4296)) (if (jolt= G__40 (keyword #f "host")) (jolt-throw (let* ((_a$4297 (jolt-invoke (var-deref "clojure.core" "str") "emit: unsupported host ref `" (jolt-get node (keyword #f "name")) "`")) (_a$4298 (jolt-hash-map))) (jolt-ex-info _a$4297 _a$4298))) (if (jolt= G__40 (keyword #f "host-static")) (let* ((_a$4299 (var-deref "clojure.core" "str")) (_a$4300 "(host-static-ref ") (_a$4301 (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") (jolt-get node (keyword #f "class")))) (_a$4302 " ") (_a$4303 (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") (jolt-get node (keyword #f "member")))) (_a$4304 ")")) (jolt-invoke _a$4299 _a$4300 _a$4301 _a$4302 _a$4303 _a$4304)) (if (jolt= G__40 (keyword #f "host-new")) (let* ((_a$4305 (var-deref "clojure.core" "str")) (_a$4306 "(host-new ") (_a$4307 (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") (jolt-get node (keyword #f "class")))) (_a$4308 (let* ((args (jolt-map emit (jolt-get node (keyword #f "args"))))) (if (jolt-empty? args) "" (jolt-invoke (var-deref "clojure.core" "str") " " (jolt-invoke (var-deref "clojure.string" "join") " " args))))) (_a$4309 ")")) (jolt-invoke _a$4305 _a$4306 _a$4307 _a$4308 _a$4309)) (if (jolt= G__40 (keyword #f "if")) (let* ((test (jolt-get node (keyword #f "test"))) (t (if (jolt-truthy? (jolt-invoke (var-deref "jolt.backend-scheme" "returns-scheme-bool?") test)) (jolt-invoke emit test) (jolt-invoke (var-deref "clojure.core" "str") "(jolt-truthy? " (jolt-invoke emit test) ")")))) (let* ((_a$4310 (var-deref "clojure.core" "str")) (_a$4311 "(if ") (_a$4312 t) (_a$4313 " ") (_a$4314 (jolt-invoke emit (jolt-get node (keyword #f "then")))) (_a$4315 " ") (_a$4316 (jolt-invoke emit (jolt-get node (keyword #f "else")))) (_a$4317 ")")) (jolt-invoke _a$4310 _a$4311 _a$4312 _a$4313 _a$4314 _a$4315 _a$4316 _a$4317))) (if (jolt= G__40 (keyword #f "do")) (let* ((_a$4318 (var-deref "clojure.core" "str")) (_a$4319 "(begin ") (_a$4320 (jolt-invoke (var-deref "clojure.string" "join") " " (jolt-map emit (jolt-get node (keyword #f "statements"))))) (_a$4321 (if (jolt-empty? (jolt-get node (keyword #f "statements"))) "" " ")) (_a$4322 (jolt-invoke emit (jolt-get node (keyword #f "ret")))) (_a$4323 ")")) (jolt-invoke _a$4318 _a$4319 _a$4320 _a$4321 _a$4322 _a$4323)) (if (jolt= G__40 (keyword #f "invoke")) (jolt-invoke (var-deref "jolt.backend-scheme" "emit-invoke") node) (if (jolt= G__40 (keyword #f "vector")) (jolt-invoke (var-deref "jolt.backend-scheme" "emit-ordered") "jolt-vector" (jolt-map emit (jolt-get node (keyword #f "items")))) (if (jolt= G__40 (keyword #f "set")) (jolt-invoke (var-deref "jolt.backend-scheme" "emit-ordered") "jolt-hash-set" (jolt-map emit (jolt-get node (keyword #f "items")))) (if (jolt= G__40 (keyword #f "map")) (jolt-invoke (var-deref "jolt.backend-scheme" "emit-ordered") "jolt-hash-map" (let* ((_a$4327 (var-deref "clojure.core" "mapcat")) (_a$4328 (lambda (p) (let fnrec4324 ((p p)) (let* ((_o$4325 (jolt-invoke emit (jolt-nth p 0))) (_o$4326 (jolt-invoke emit (jolt-nth p 1)))) (jolt-vector _o$4325 _o$4326))))) (_a$4329 (jolt-get node (keyword #f "pairs")))) (jolt-invoke _a$4327 _a$4328 _a$4329))) (if (jolt= G__40 (keyword #f "quote")) (jolt-invoke (var-deref "jolt.backend-scheme" "emit-quoted") (jolt-get node (keyword #f "form"))) (if (jolt= G__40 (keyword #f "throw")) (jolt-invoke (var-deref "clojure.core" "str") "(jolt-throw " (jolt-invoke emit (jolt-get node (keyword #f "expr"))) ")") (if (jolt= G__40 (keyword #f "try")) (jolt-invoke (var-deref "jolt.backend-scheme" "emit-try") node) (if (jolt= G__40 (keyword #f "regex")) (jolt-invoke (var-deref "clojure.core" "str") "(jolt-regex " (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") (jolt-get node (keyword #f "source"))) ")") (if (jolt= G__40 (keyword #f "inst")) (jolt-invoke (var-deref "clojure.core" "str") "(jolt-inst-from-string " (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") (jolt-get node (keyword #f "source"))) ")") (if (jolt= G__40 (keyword #f "uuid")) (jolt-invoke (var-deref "clojure.core" "str") "(jolt-uuid-from-string " (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") (jolt-get node (keyword #f "source"))) ")") (if (jolt= G__40 (keyword #f "bigdec")) (jolt-invoke (var-deref "clojure.core" "str") "(jolt-bigdec-from-string " (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") (jolt-get node (keyword #f "source"))) ")") (if (jolt= G__40 (keyword #f "the-ns")) (jolt-invoke (var-deref "clojure.core" "str") "(intern-ns! " (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") (jolt-get node (keyword #f "name"))) ")") (if (jolt= G__40 (keyword #f "host-call")) (let* ((m (jolt-get node (keyword #f "method"))) (target (jolt-invoke emit (jolt-get node (keyword #f "target")))) (args (jolt-map emit (jolt-get node (keyword #f "args"))))) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.backend-scheme" "supported-host-methods") m)) (let* ((_a$4330 (var-deref "clojure.core" "str")) (_a$4331 "(jolt-host-call ") (_a$4332 (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") m)) (_a$4333 " ") (_a$4334 target) (_a$4335 (if (jolt-empty? args) "" (jolt-invoke (var-deref "clojure.core" "str") " " (jolt-invoke (var-deref "clojure.string" "join") " " args)))) (_a$4336 ")")) (jolt-invoke _a$4330 _a$4331 _a$4332 _a$4333 _a$4334 _a$4335 _a$4336)) (let* ((_a$4337 (var-deref "clojure.core" "str")) (_a$4338 "(record-method-dispatch ") (_a$4339 target) (_a$4340 " ") (_a$4341 (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") m)) (_a$4342 " (jolt-vector") (_a$4343 (if (jolt-empty? args) "" (jolt-invoke (var-deref "clojure.core" "str") " " (jolt-invoke (var-deref "clojure.string" "join") " " args)))) (_a$4344 "))")) (jolt-invoke _a$4337 _a$4338 _a$4339 _a$4340 _a$4341 _a$4342 _a$4343 _a$4344)))) (if (jolt= G__40 (keyword #f "let")) (jolt-invoke (var-deref "jolt.backend-scheme" "emit-let") node) (if (jolt= G__40 (keyword #f "loop")) (jolt-invoke (var-deref "jolt.backend-scheme" "emit-loop") node) (if (jolt= G__40 (keyword #f "recur")) (jolt-invoke (var-deref "jolt.backend-scheme" "emit-recur") node) (if (jolt= G__40 (keyword #f "ffi-fn")) (jolt-invoke (var-deref "jolt.backend-scheme" "emit-ffi-fn") node) (if (jolt= G__40 (keyword #f "ffi-callable")) (jolt-invoke (var-deref "jolt.backend-scheme" "emit-ffi-callable") node) (if (jolt= G__40 (keyword #f "fn")) (jolt-invoke (var-deref "jolt.backend-scheme" "emit-fn") node) (if (jolt= G__40 (keyword #f "def")) (if (jolt-truthy? (jolt-get node (keyword #f "no-init"))) (let* ((_a$4345 (var-deref "clojure.core" "str")) (_a$4346 "(declare-var! ") (_a$4347 (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") (jolt-get node (keyword #f "ns")))) (_a$4348 " ") (_a$4349 (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") (jolt-get node (keyword #f "name")))) (_a$4350 ")")) (jolt-invoke _a$4345 _a$4346 _a$4347 _a$4348 _a$4349 _a$4350)) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.backend-scheme" "jmeta-nonempty?") (jolt-get node (keyword #f "meta")))) (let* ((_a$4351 (var-deref "clojure.core" "str")) (_a$4352 "(def-var-with-meta! ") (_a$4353 (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") (jolt-get node (keyword #f "ns")))) (_a$4354 " ") (_a$4355 (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") (jolt-get node (keyword #f "name")))) (_a$4356 " ") (_a$4357 (jolt-invoke emit (jolt-get node (keyword #f "init")))) (_a$4358 " ") (_a$4359 (jolt-invoke (var-deref "jolt.backend-scheme" "emit-quoted") (jolt-get node (keyword #f "meta")))) (_a$4360 ")")) (jolt-invoke _a$4351 _a$4352 _a$4353 _a$4354 _a$4355 _a$4356 _a$4357 _a$4358 _a$4359 _a$4360)) (if (jolt-truthy? (keyword #f "else")) (let* ((_a$4361 (var-deref "clojure.core" "str")) (_a$4362 "(def-var! ") (_a$4363 (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") (jolt-get node (keyword #f "ns")))) (_a$4364 " ") (_a$4365 (jolt-invoke (var-deref "jolt.backend-scheme" "chez-str-lit") (jolt-get node (keyword #f "name")))) (_a$4366 " ") (_a$4367 (jolt-invoke emit (jolt-get node (keyword #f "init")))) (_a$4368 ")")) (jolt-invoke _a$4361 _a$4362 _a$4363 _a$4364 _a$4365 _a$4366 _a$4367 _a$4368)) jolt-nil))) (jolt-throw (let* ((_a$4369 (jolt-invoke (var-deref "clojure.core" "str") "emit: op not yet ported / unhandled: " (jolt-invoke (var-deref "clojure.core" "pr-str") (jolt-get node (keyword #f "op"))))) (_a$4370 (jolt-hash-map))) (jolt-ex-info _a$4369 _a$4370)))))))))))))))))))))))))))))))))))))))) emit))) (guard (e (#t #f)) - (def-var! "jolt.passes.fold" "const?" (letrec ((const? (lambda (n) (let fnrec4395 ((n n)) (jolt= (keyword #f "const") (jolt-get n (keyword #f "op"))))))) const?))) + (def-var-with-meta! "jolt.passes.fold" "foldable" (let* ((_o$4371 "+") (_o$4372 jolt-add) (_o$4373 "-") (_o$4374 jolt-sub) (_o$4375 "*") (_o$4376 jolt-mul) (_o$4377 "/") (_o$4378 jolt-div) (_o$4379 "<") (_o$4380 <) (_o$4381 ">") (_o$4382 >) (_o$4383 "<=") (_o$4384 <=) (_o$4385 ">=") (_o$4386 >=) (_o$4387 "=") (_o$4388 jolt=) (_o$4389 "inc") (_o$4390 jolt-inc) (_o$4391 "dec") (_o$4392 jolt-dec) (_o$4393 "mod") (_o$4394 modulo) (_o$4395 "rem") (_o$4396 remainder) (_o$4397 "quot") (_o$4398 quotient) (_o$4399 "bit-and") (_o$4400 (var-deref "clojure.core" "__bit-and")) (_o$4401 "bit-or") (_o$4402 (var-deref "clojure.core" "__bit-or")) (_o$4403 "bit-xor") (_o$4404 (var-deref "clojure.core" "__bit-xor"))) (jolt-hash-map _o$4371 _o$4372 _o$4373 _o$4374 _o$4375 _o$4376 _o$4377 _o$4378 _o$4379 _o$4380 _o$4381 _o$4382 _o$4383 _o$4384 _o$4385 _o$4386 _o$4387 _o$4388 _o$4389 _o$4390 _o$4391 _o$4392 _o$4393 _o$4394 _o$4395 _o$4396 _o$4397 _o$4398 _o$4399 _o$4400 _o$4401 _o$4402 _o$4403 _o$4404)) (jolt-hash-map (keyword #f "private") #t))) (guard (e (#t #f)) - (def-var! "jolt.passes.fold" "const-num?" (letrec ((const-num? (lambda (n) (let fnrec4396 ((n n)) (let* ((and__13__auto (jolt-invoke (var-deref "jolt.passes.fold" "const?") n))) (if (jolt-truthy? and__13__auto) (jolt-invoke (var-deref "clojure.core" "number?") (jolt-get n (keyword #f "val"))) and__13__auto)))))) const-num?))) + (def-var! "jolt.passes.fold" "const?" (letrec ((const? (lambda (n) (let fnrec4405 ((n n)) (jolt= (keyword #f "const") (jolt-get n (keyword #f "op"))))))) const?))) (guard (e (#t #f)) - (def-var! "jolt.passes.fold" "fold-fn" (letrec ((fold-fn (lambda (fnode) (let fnrec4397 ((fnode fnode)) (let* ((op (jolt-get fnode (keyword #f "op")))) (if (jolt-truthy? (let* ((or__14__auto (let* ((and__13__auto (jolt= op (keyword #f "var")))) (if (jolt-truthy? and__13__auto) (jolt= "clojure.core" (jolt-get fnode (keyword #f "ns"))) and__13__auto)))) (if (jolt-truthy? or__14__auto) or__14__auto (jolt= op (keyword #f "host"))))) (jolt-get (var-deref "jolt.passes.fold" "foldable") (jolt-get fnode (keyword #f "name"))) jolt-nil)))))) fold-fn))) + (def-var! "jolt.passes.fold" "const-num?" (letrec ((const-num? (lambda (n) (let fnrec4406 ((n n)) (let* ((and__13__auto (jolt-invoke (var-deref "jolt.passes.fold" "const?") n))) (if (jolt-truthy? and__13__auto) (jolt-invoke (var-deref "clojure.core" "number?") (jolt-get n (keyword #f "val"))) and__13__auto)))))) const-num?))) (guard (e (#t #f)) - (def-var! "jolt.passes.fold" "const-fold" (letrec ((const-fold (lambda (node) (let fnrec4398 ((node node)) (let* ((op (jolt-get node (keyword #f "op")))) (if (jolt= op (keyword #f "invoke")) (let* ((n (jolt-invoke (var-deref "jolt.ir" "map-ir-children") const-fold node)) (ff (jolt-invoke (var-deref "jolt.passes.fold" "fold-fn") (jolt-get n (keyword #f "fn")))) (args (jolt-get n (keyword #f "args"))) (folded (if (jolt-truthy? (let* ((and__13__auto ff)) (if (jolt-truthy? and__13__auto) (let* ((and__13__auto (jolt-pos? (jolt-count args)))) (if (jolt-truthy? and__13__auto) (jolt-invoke (var-deref "clojure.core" "every?") (var-deref "jolt.passes.fold" "const-num?") args) and__13__auto)) and__13__auto))) (guard (e (else jolt-nil)) (let* ((_o$4400 (keyword #f "op")) (_o$4401 (keyword #f "const")) (_o$4402 (keyword #f "val")) (_o$4403 (jolt-apply ff (jolt-invoke (var-deref "clojure.core" "mapv") (lambda (a) (let fnrec4399 ((a a)) (jolt-get a (keyword #f "val")))) args)))) (jolt-hash-map _o$4400 _o$4401 _o$4402 _o$4403))) jolt-nil))) (let* ((or__14__auto folded)) (if (jolt-truthy? or__14__auto) or__14__auto n))) (if (jolt= op (keyword #f "if")) (let* ((t (jolt-invoke const-fold (jolt-get node (keyword #f "test"))))) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.passes.fold" "const?") t)) (if (jolt-truthy? (let* ((or__14__auto (jolt-invoke (var-deref "clojure.core" "nil?") (jolt-get t (keyword #f "val"))))) (if (jolt-truthy? or__14__auto) or__14__auto (jolt= #f (jolt-get t (keyword #f "val")))))) (jolt-invoke const-fold (jolt-get node (keyword #f "else"))) (jolt-invoke const-fold (jolt-get node (keyword #f "then")))) (let* ((_a$4404 node) (_a$4405 (keyword #f "test")) (_a$4406 t) (_a$4407 (keyword #f "then")) (_a$4408 (jolt-invoke const-fold (jolt-get node (keyword #f "then")))) (_a$4409 (keyword #f "else")) (_a$4410 (jolt-invoke const-fold (jolt-get node (keyword #f "else"))))) (jolt-assoc _a$4404 _a$4405 _a$4406 _a$4407 _a$4408 _a$4409 _a$4410)))) (if (jolt-truthy? (keyword #f "else")) (jolt-invoke (var-deref "jolt.ir" "map-ir-children") const-fold node) jolt-nil)))))))) const-fold))) + (def-var! "jolt.passes.fold" "fold-fn" (letrec ((fold-fn (lambda (fnode) (let fnrec4407 ((fnode fnode)) (let* ((op (jolt-get fnode (keyword #f "op")))) (if (jolt-truthy? (let* ((or__14__auto (let* ((and__13__auto (jolt= op (keyword #f "var")))) (if (jolt-truthy? and__13__auto) (jolt= "clojure.core" (jolt-get fnode (keyword #f "ns"))) and__13__auto)))) (if (jolt-truthy? or__14__auto) or__14__auto (jolt= op (keyword #f "host"))))) (jolt-get (var-deref "jolt.passes.fold" "foldable") (jolt-get fnode (keyword #f "name"))) jolt-nil)))))) fold-fn))) (guard (e (#t #f)) - (def-var! "jolt.passes.fold" "scalar-const?" (letrec ((scalar-const? (lambda (n) (let fnrec4411 ((n n)) (let* ((and__13__auto (jolt= (keyword #f "const") (jolt-get n (keyword #f "op"))))) (if (jolt-truthy? and__13__auto) (let* ((v (jolt-get n (keyword #f "val")))) (let* ((or__14__auto (jolt-invoke (var-deref "clojure.core" "keyword?") v))) (if (jolt-truthy? or__14__auto) or__14__auto (let* ((or__14__auto (jolt-invoke (var-deref "clojure.core" "string?") v))) (if (jolt-truthy? or__14__auto) or__14__auto (let* ((or__14__auto (jolt-invoke (var-deref "clojure.core" "number?") v))) (if (jolt-truthy? or__14__auto) or__14__auto (jolt-invoke (var-deref "clojure.core" "boolean?") v)))))))) and__13__auto)))))) scalar-const?))) + (def-var! "jolt.passes.fold" "const-fold" (letrec ((const-fold (lambda (node) (let fnrec4408 ((node node)) (let* ((op (jolt-get node (keyword #f "op")))) (if (jolt= op (keyword #f "invoke")) (let* ((n (jolt-invoke (var-deref "jolt.ir" "map-ir-children") const-fold node)) (ff (jolt-invoke (var-deref "jolt.passes.fold" "fold-fn") (jolt-get n (keyword #f "fn")))) (args (jolt-get n (keyword #f "args"))) (folded (if (jolt-truthy? (let* ((and__13__auto ff)) (if (jolt-truthy? and__13__auto) (let* ((and__13__auto (jolt-pos? (jolt-count args)))) (if (jolt-truthy? and__13__auto) (jolt-invoke (var-deref "clojure.core" "every?") (var-deref "jolt.passes.fold" "const-num?") args) and__13__auto)) and__13__auto))) (guard (e (else jolt-nil)) (let* ((_o$4410 (keyword #f "op")) (_o$4411 (keyword #f "const")) (_o$4412 (keyword #f "val")) (_o$4413 (jolt-apply ff (jolt-invoke (var-deref "clojure.core" "mapv") (lambda (a) (let fnrec4409 ((a a)) (jolt-get a (keyword #f "val")))) args)))) (jolt-hash-map _o$4410 _o$4411 _o$4412 _o$4413))) jolt-nil))) (let* ((or__14__auto folded)) (if (jolt-truthy? or__14__auto) or__14__auto n))) (if (jolt= op (keyword #f "if")) (let* ((t (jolt-invoke const-fold (jolt-get node (keyword #f "test"))))) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.passes.fold" "const?") t)) (if (jolt-truthy? (let* ((or__14__auto (jolt-invoke (var-deref "clojure.core" "nil?") (jolt-get t (keyword #f "val"))))) (if (jolt-truthy? or__14__auto) or__14__auto (jolt= #f (jolt-get t (keyword #f "val")))))) (jolt-invoke const-fold (jolt-get node (keyword #f "else"))) (jolt-invoke const-fold (jolt-get node (keyword #f "then")))) (let* ((_a$4414 node) (_a$4415 (keyword #f "test")) (_a$4416 t) (_a$4417 (keyword #f "then")) (_a$4418 (jolt-invoke const-fold (jolt-get node (keyword #f "then")))) (_a$4419 (keyword #f "else")) (_a$4420 (jolt-invoke const-fold (jolt-get node (keyword #f "else"))))) (jolt-assoc _a$4414 _a$4415 _a$4416 _a$4417 _a$4418 _a$4419 _a$4420)))) (if (jolt-truthy? (keyword #f "else")) (jolt-invoke (var-deref "jolt.ir" "map-ir-children") const-fold node) jolt-nil)))))))) const-fold))) +(guard (e (#t #f)) + (def-var! "jolt.passes.fold" "scalar-const?" (letrec ((scalar-const? (lambda (n) (let fnrec4421 ((n n)) (let* ((and__13__auto (jolt= (keyword #f "const") (jolt-get n (keyword #f "op"))))) (if (jolt-truthy? and__13__auto) (let* ((v (jolt-get n (keyword #f "val")))) (let* ((or__14__auto (jolt-invoke (var-deref "clojure.core" "keyword?") v))) (if (jolt-truthy? or__14__auto) or__14__auto (let* ((or__14__auto (jolt-invoke (var-deref "clojure.core" "string?") v))) (if (jolt-truthy? or__14__auto) or__14__auto (let* ((or__14__auto (jolt-invoke (var-deref "clojure.core" "number?") v))) (if (jolt-truthy? or__14__auto) or__14__auto (jolt-invoke (var-deref "clojure.core" "boolean?") v)))))))) and__13__auto)))))) scalar-const?))) (guard (e (#t #f)) (def-var! "jolt.passes.inline" "dirty" (jolt-invoke (var-deref "clojure.core" "atom") #f))) (guard (e (#t #f)) diff --git a/jolt-core/jolt/analyzer.clj b/jolt-core/jolt/analyzer.clj index 5dd2e38..13d09e0 100644 --- a/jolt-core/jolt/analyzer.clj +++ b/jolt-core/jolt/analyzer.clj @@ -424,6 +424,28 @@ :rettype (name (nth items 3)) :blocking (and (= 5 (count items)) (= "blocking" (name (nth items 4))))}) +;; jolt.ffi/__ccallable: the foreign-CALLBACK form (via the jolt.ffi/foreign-callable +;; macro) — the inverse of __cfn. It wraps a jolt fn as a C-callable function +;; pointer so C can call back INTO jolt (GTK signal handlers, qsort comparators). +;; Shape: +;; (jolt.ffi/__ccallable f [:argtype ...] :rettype) ; thread stays active +;; (jolt.ffi/__ccallable f [:argtype ...] :rettype :collect-safe) ; may be invoked +;; ; while the thread is +;; ; parked in a :blocking call +;; Unlike __cfn, the fn is a CHILD expression (analyzed + walked by the passes); +;; the types are literal keywords read at compile time. The Chez back end lowers +;; it to a locked `foreign-callable` and returns its entry-point address (a jolt +;; pointer). :collect-safe is required when C invokes the callback from a thread +;; that is deactivated inside a :blocking foreign call (e.g. a GTK main loop). +(defn- analyze-ffi-callable [ctx items env] + (when-not (<= 4 (count items) 5) + (throw (str "jolt.ffi/foreign-callable expects (foreign-callable f [argtypes] rettype [:collect-safe])"))) + {:op :ffi-callable + :fn (analyze ctx (nth items 1) env) + :argtypes (mapv name (form-vec-items (nth items 2))) + :rettype (name (nth items 3)) + :collect-safe (and (= 5 (count items)) (= "collect-safe" (name (nth items 4))))}) + ;; The `.` special form: `(. target member arg*)` — member access / method call. ;; A symbol member whose name starts with "-" is a field read; otherwise it is a ;; method (call with the trailing args). Both lower to a :host-call carrying the @@ -506,6 +528,11 @@ (and (form-sym? head) (= "jolt.ffi" (form-sym-ns head)) (= "__cfn" (form-sym-name head))) (analyze-ffi-fn ctx items env) + ;; jolt.ffi/__ccallable — the foreign-callback special form (the fn is a + ;; child expression, analyzed here). + (and (form-sym? head) (= "jolt.ffi" (form-sym-ns head)) + (= "__ccallable" (form-sym-name head))) + (analyze-ffi-callable ctx items env) ;; special-form heads are NOT shadowable (unlike macros): a local named ;; `if` does not change the meaning of (if …) in operator position, per ;; spec §3 and the reference. No (not shadowed) guard here. diff --git a/jolt-core/jolt/backend_scheme.clj b/jolt-core/jolt/backend_scheme.clj index d09e5f0..564dc60 100644 --- a/jolt-core/jolt/backend_scheme.clj +++ b/jolt-core/jolt/backend_scheme.clj @@ -287,6 +287,19 @@ " (" (str/join " " (map ffi-type->chez (:argtypes node))) ") " (ffi-type->chez (:rettype node)) ")")) +;; jolt.ffi/__ccallable -> a Chez foreign-callable wrapping the emitted jolt fn, +;; locked + registered (jolt-ffi-register-callable!, host/chez/ffi.ss) so the +;; collector neither moves nor reclaims it while C may still call through it. The +;; expression evaluates to the entry-point address — a jolt pointer the caller +;; hands to C. :collect-safe emits the convention that reactivates the thread on +;; entry, for callbacks invoked while it is parked in a :blocking foreign call. +(defn- emit-ffi-callable [node] + (str "(jolt-ffi-register-callable! (foreign-callable " + (when (:collect-safe node) "__collect_safe ") + (emit (:fn node)) + " (" (str/join " " (map ffi-type->chez (:argtypes node))) ") " + (ffi-type->chez (:rettype node)) "))")) + (defn- emit-recur [node] (when-not *recur-target* (throw (ex-info "emit: recur outside a loop/fn target" {}))) (let [arg-nodes (:args node)] @@ -500,6 +513,7 @@ :loop (emit-loop node) :recur (emit-recur node) :ffi-fn (emit-ffi-fn node) + :ffi-callable (emit-ffi-callable node) :fn (emit-fn node) ;; (def name) with no init (declare): reserve the cell. A def with non-empty ;; reader metadata lowers to def-var-with-meta! (ported in a later increment). diff --git a/jolt-core/jolt/ir.clj b/jolt-core/jolt/ir.clj index f7bf29b..a276412 100644 --- a/jolt-core/jolt/ir.clj +++ b/jolt-core/jolt/ir.clj @@ -94,6 +94,7 @@ (= op :set-var) (assoc node :val (f (get node :val))) (= op :set-field) (assoc node :obj (f (get node :obj)) :val (f (get node :val))) (= op :defmacro) (assoc node :fn (f (get node :fn))) + (= op :ffi-callable) (assoc node :fn (f (get node :fn))) (= op :invoke) (assoc node :fn (f (get node :fn)) :args (mapv f (get node :args))) (= op :vector) (assoc node :items (mapv f (get node :items))) @@ -140,6 +141,7 @@ (= op :set-var) (f acc (get node :val)) (= op :set-field) (f (f acc (get node :obj)) (get node :val)) (= op :defmacro) (f acc (get node :fn)) + (= op :ffi-callable) (f acc (get node :fn)) (= op :invoke) (reduce f (f acc (get node :fn)) (get node :args)) (= op :vector) (reduce f acc (get node :items)) (= op :set) (reduce f acc (get node :items)) diff --git a/stdlib/jolt/ffi.clj b/stdlib/jolt/ffi.clj index 3ed25ee..ef20bcd 100644 --- a/stdlib/jolt/ffi.clj +++ b/stdlib/jolt/ffi.clj @@ -16,7 +16,9 @@ The memory/library primitives (alloc/free/read/write/sizeof/load-library/ ptr->string/string->ptr/null/null?) are provided by the host. foreign-fn lowers - a compile-time-typed signature to a real Chez foreign-procedure.") + a compile-time-typed signature to a real Chez foreign-procedure. foreign-callable + is the inverse — it wraps a jolt fn as a C-callable function pointer so C can + call back into jolt (e.g. GTK signal handlers); free-callable releases it.") ;; foreign-fn binds C symbol `csym` to a typed callable. Expands to the __cfn ;; special form (always fully-qualified, so an :as alias on jolt.ffi resolves): @@ -33,3 +35,19 @@ (list 'def name (if (= opt :blocking) (list 'jolt.ffi/__cfn csym argtypes rettype :blocking) (list 'jolt.ffi/__cfn csym argtypes rettype)))) + +;; foreign-callable wraps a jolt fn `f` as a C-callable function pointer — the +;; inverse of foreign-fn, so C can call back INTO jolt (GTK signal handlers, a +;; qsort comparator, any C API that takes a callback). Returns the pointer; pass +;; it where C expects a function pointer. argtypes/rettype use the same keywords +;; as foreign-fn; the args C passes arrive as jolt values and the jolt return is +;; marshaled back. The callback stays live until free-callable is called on the +;; pointer. Pass a trailing :collect-safe when C invokes the callback from a +;; thread parked in a :blocking foreign call (e.g. a GTK main loop): +;; (g-signal-connect button "clicked" +;; (ffi/foreign-callable on-click [:pointer :pointer] :void :collect-safe) +;; (ffi/null)) +(defmacro foreign-callable [f argtypes rettype & [opt]] + (if (= opt :collect-safe) + (list 'jolt.ffi/__ccallable f argtypes rettype :collect-safe) + (list 'jolt.ffi/__ccallable f argtypes rettype))) diff --git a/test/chez/ffi-binding-test.ss b/test/chez/ffi-binding-test.ss index db8f290..b53a178 100644 --- a/test/chez/ffi-binding-test.ss +++ b/test/chez/ffi-binding-test.ss @@ -61,5 +61,29 @@ (let loop ((i 0)) (when (fx a b) 1 :else 0))) + [:pointer :pointer] :int))") +(ok "foreign-callable returns a pointer" + (let ((p (jnum->exact (var-deref "user" "cmp")))) (and (integer? p) (> p 0)))) +(ev "(def c-qsort (jolt.ffi/__cfn \"qsort\" [:pointer :size_t :size_t :pointer] :void))") +(ok "C calls back into jolt: qsort with a jolt comparator" + (jolt-truthy? + (ev "(let [n 5 w (jolt.ffi/sizeof :int) p (jolt.ffi/alloc (* n w))] + (doseq [[i v] (map vector (range n) [3 1 4 1 5])] + (jolt.ffi/write p :int (* i w) v)) + (c-qsort p n w cmp) + (let [out (mapv (fn [i] (jolt.ffi/read p :int (* i w))) (range n))] + (jolt.ffi/free p) + (= out [1 1 3 4 5])))"))) +;; free-callable unlocks + drops the code object, returning nil. +(ok "free-callable releases the callback" + (jolt-nil? (ev "(jolt.ffi/free-callable cmp)"))) + (printf "~a/~a passed~n" (- total fails) total) (exit (if (zero? fails) 0 1)) From 22c08d30f205a7f25b3e62f7601f465c923272cf Mon Sep 17 00:00:00 2001 From: Yogthos Date: Tue, 23 Jun 2026 10:02:23 -0400 Subject: [PATCH 2/3] remove ffi_smoke.clj --- ffi_smoke.clj | 13 ------------- 1 file changed, 13 deletions(-) delete mode 100644 ffi_smoke.clj diff --git a/ffi_smoke.clj b/ffi_smoke.clj deleted file mode 100644 index b862010..0000000 --- a/ffi_smoke.clj +++ /dev/null @@ -1,13 +0,0 @@ -(ns ffi-smoke - (:require [jolt.ffi :as ffi])) -(ffi/load-library "libglib-2.0.dylib") -(prn :sizeof-pointer (ffi/sizeof :pointer)) -(prn :null (ffi/null)) -(prn :null? (ffi/null? (ffi/null))) -(ffi/defcfn g-get-monotonic-time "g_get_monotonic_time" [] :int64) -(prn :monotonic-time (g-get-monotonic-time)) -(let [p (ffi/alloc 16)] - (ffi/write p :int64 0 42) - (prn :wrote-and-read (ffi/read p :int64 0)) - (ffi/free p)) -(prn :done) From 1d345bfd0fe2d325fb4cc678d904879a47731055 Mon Sep 17 00:00:00 2001 From: Yogthos Date: Tue, 23 Jun 2026 13:19:33 -0400 Subject: [PATCH 3/3] jolt build: bundle native libs + resources into standalone binaries A built binary dropped its deps.edn :jolt/native declarations and its resource roots, so an FFI+resources app (ring-app) failed at runtime: sockets/sqlite gave 'no entry for socket' and io/resource returned nil. The buildsmoke fixture is pure compute, so neither path was exercised. The launcher now loads required + :process native libs before the app's top-level forms (a library's defcfn resolves its foreign-procedure symbols at top-level eval during startup, so the libs must be loaded first); optional libs load in the scheme-start launcher, where a missing lib is caught rather than aborting the heap build. deps.edn :jolt/build {:embed [dirs]} bakes those dirs' files into the heap (register-embedded-resource! at heap build), so io/resource serves them with no files on disk. Non-embedded resources resolve at runtime against JOLT_PWD, and io/file reads (e.g. config.edn) stay external. build-binary now takes the encoded natives, embed dirs, and project paths from cmd-build; deps/resolve-project surfaces them. Buildsmoke fixture grows an embedded resource + a :process native to cover both paths. --- docs/tools-deps.md | 30 +++++++ host/chez/build-smoke.sh | 7 +- host/chez/build.ss | 99 ++++++++++++++++++++-- host/chez/ffi.ss | 18 ++++ host/chez/io.ss | 24 ++++-- jolt-core/jolt/deps.clj | 8 ++ jolt-core/jolt/main.clj | 61 ++++++++----- test/chez/build-app/deps.edn | 9 +- test/chez/build-app/resources/greeting.txt | 1 + test/chez/build-app/src/app/core.clj | 6 +- 10 files changed, 227 insertions(+), 36 deletions(-) create mode 100644 test/chez/build-app/resources/greeting.txt diff --git a/docs/tools-deps.md b/docs/tools-deps.md index 84461ca..e0dab76 100644 --- a/docs/tools-deps.md +++ b/docs/tools-deps.md @@ -56,11 +56,41 @@ roots, and de-sugars the argv into a run: - `-A:alias` → add the alias's paths/deps, then run the rest; - `repl` → a line REPL; - `path` → print the resolved roots; +- `build -m NS [-o OUT] [--opt|--dev]` → AOT-compile the app into a standalone binary; - `` → run a `deps.edn` `:tasks` entry. The resolver lives in the overlay alongside the runtime, but the runtime's only dependency interface is the list of source roots it's handed. +## Native libraries + +A library that binds C declares the shared objects it needs under `:jolt/native`, +so `jolt.main` loads them before the namespace is required and its `foreign-fn` +bindings resolve. Each entry is a map — `{:name "sqlite3" :darwin +["libsqlite3.0.dylib" …] :linux ["libsqlite3.so.0" …]}` — with optional +`:optional true` (absence is fine, a feature-gated dep) and `:process true` (use +the running process's own symbols, e.g. libc sockets, no external file). A +project inherits its dependencies' `:jolt/native`. + +## Standalone binaries + +`joltc build -m NS -o OUT` compiles the app and every library into one +executable (the runtime + compiler are baked in). It loads the resolved +`:jolt/native` libs at startup, so an FFI app — sockets, SQLite — runs with no +jolt or Chez on the path. + +`:jolt/build {:embed ["resources" …]}` bakes those directories' files into the +binary; `io/resource` serves them from the image with no files on disk. Resources +not embedded resolve at runtime against `JOLT_PWD` (or the cwd), so the +ship-the-binary-with-its-`resources/`-dir model also works. Files read through +`io/file` (e.g. a `config.edn` a config library loads) stay external by design — +edit them without rebuilding. + +A standalone build needs Chez's kernel dev files (`libkernel.a`, `scheme.h`) and +a C compiler; `JOLT_CHEZ_CSV` overrides the auto-detected `csv/` +dir. `--opt` turns on the inference/flatten/scalar-replace passes; the default +`release` mode is const-fold only. + ## Limitations - Pure `clj`/`cljc` only — JVM interop, host classes, and unimplemented diff --git a/host/chez/build-smoke.sh b/host/chez/build-smoke.sh index 883b853..9187211 100755 --- a/host/chez/build-smoke.sh +++ b/host/chez/build-smoke.sh @@ -36,9 +36,12 @@ if ! JOLT_PWD="$app" bin/joltc build -m app.core -o "$out" >/dev/null 2>&1; then fi [ -x "$out" ] || { echo " FAIL: no executable produced"; exit 1; } -# Run from a neutral cwd with args; check the three output lines. +# Run from a neutral cwd with args. The first line is an embedded resource +# (deps.edn :jolt/build :embed), proving io/resource resolves from the binary with +# no resources/ dir on disk; the rest exercise a macro, cross-ns, and args. got="$(cd / && "$out" alpha bb ccc 2>&1)" -want='HELLO FROM A BUILT BINARY! +want='embedded resource ok +HELLO FROM A BUILT BINARY! HELLO FROM A BUILT BINARY! args: [alpha bb ccc] sum: 10' diff --git a/host/chez/build.ss b/host/chez/build.ss index 3d52646..755647a 100644 --- a/host/chez/build.ss +++ b/host/chez/build.ss @@ -146,12 +146,72 @@ ;; The loop itself is emit-image's ei-emit-ns* (optimize? #t, guard? #f). (define (bld-emit-ns ns-name src) (ei-emit-ns* ns-name src #t #f)) +;; --- bundling: native libs + resources -------------------------------------- +;; A jolt seq of jolt strings -> a Scheme list of Scheme strings. +(define (bld-strs x) (map jolt-str-render-one (seq->list x))) + +;; Emit native-library loads. `natives` is the encoded jolt seq jolt.main/ +;; encode-natives produced: each entry is ["process"] | ["req" cand…] | ["opt" cand…]. +;; `which` selects 'required (process + req) or 'optional. Required + process loads +;; are emitted before the app forms (the app's defcfn foreign-procedures resolve +;; their symbols at top-level eval during startup, so the libs must be loaded +;; first); a load-shared-object failure there is fatal — correct for a required +;; lib. Optional loads run in the scheme-start launcher, where guard catches a +;; missing lib (an optional lib's namespace is only present when the app requires +;; it, so its foreign-procedures aren't among the baked top-level forms). +(define (bld-emit-natives out natives which) + (for-each + (lambda (entry) + (let* ((parts (bld-strs entry)) (kind (car parts)) (cands (cdr parts)) + (cand-lits (fold-left (lambda (s c) (string-append s (ei-str-lit c) " ")) "" cands))) + (cond + ((and (eq? which 'required) (string=? kind "process")) + (put-string out "(jolt-build-load-native '() #f #t)\n")) + ((and (eq? which 'required) (string=? kind "req")) + (put-string out (string-append "(jolt-build-load-native (list " cand-lits ") #f #f)\n"))) + ((and (eq? which 'optional) (string=? kind "opt")) + (put-string out (string-append "(jolt-build-load-native (list " cand-lits ") #t #f)\n")))))) + (seq->list natives))) + +;; Walk an embed root recursively; return (resource-name . abspath) pairs, where +;; resource-name is the "/"-joined path under the root (what io/resource is asked for). +(define (bld-walk-files root rel acc) + (let ((dir (if (string=? rel "") root (string-append root "/" rel)))) + (fold-left + (lambda (acc name) + (let* ((relpath (if (string=? rel "") name (string-append rel "/" name))) + (full (string-append root "/" relpath))) + (if (file-directory? full) + (bld-walk-files root relpath acc) + (cons (cons relpath full) acc)))) + acc + (directory-list dir)))) + +;; Emit register-embedded-resource! per file under each embed dir. Emitted BEFORE +;; the app forms so the (read-file-string ABSPATH) runs at heap build — the file's +;; contents bake into the boot image and io/resource serves them with no file on +;; disk. ABSPATH only has to exist at build time. +(define (bld-emit-embeds out embed-dirs) + (for-each + (lambda (root) + (when (file-directory? root) + (for-each + (lambda (rp) + (put-string out (string-append + "(register-embedded-resource! " (ei-str-lit (car rp)) + " (read-file-string " (ei-str-lit (cdr rp)) "))\n"))) + (bld-walk-files root "" '())))) + (bld-strs embed-dirs))) + ;; --- the build -------------------------------------------------------------- ;; entry-ns: the app's main namespace (a string). out-path: the binary to write. ;; mode: "dev" | "release" | "optimized". Every form runs through jolt.passes/ ;; run-passes (const-fold always; inline + type inference when optimized turns on ;; direct-linking). Deps + source roots are already applied by the caller. -(define (build-binary entry-ns out-path mode) +;; natives: encoded :jolt/native libs to load at startup. embed-dirs: dirs whose +;; files bake into the binary (single-file). ext-roots: project-relative io/resource +;; roots resolved at runtime against JOLT_PWD (ship-alongside resources). +(define (build-binary entry-ns out-path mode natives embed-dirs ext-roots) (bld-check-toolchain) ;; 1. record app namespaces in dependency order as they finish loading. (let ((app-order '())) @@ -180,16 +240,40 @@ ;; 3. flat source = runtime + app + launcher. (let ((out (open-output-file flat-ss 'replace))) (bld-emit-runtime out) + ;; Load native libs, bake embedded resources, and point source roots at + ;; the build-time app roots — all BEFORE the app forms. The app's + ;; top-level forms run at binary startup (Sbuild_heap), and they include + ;; foreign-procedure evals (a library's defcfn) and (slurp (io/resource …)) + ;; reads. So the libraries must be loaded and resources resolvable by the + ;; time those forms run, not later in the scheme-start launcher. + (put-string out "\n;; === native libraries (required) ===\n") + (bld-emit-natives out natives 'required) + (put-string out "\n;; === embedded resources ===\n") + (bld-emit-embeds out embed-dirs) + (put-string out (string-append + "(set-source-roots! (list " + (fold-left (lambda (s r) (string-append s (ei-str-lit r) " ")) "" + (get-source-roots)) + "))\n")) (put-string out "\n;; === app ===\n") (for-each (lambda (s) (put-string out s) (put-string out "\n")) app-strs) ;; The launcher runs as Chez's scheme-start (so argv reaches -main — ;; top-level boot forms run during heap build, before args are set), and - ;; suppresses the interactive greeting. + ;; suppresses the interactive greeting. It resets source roots to the + ;; app's resource dirs resolved against JOLT_PWD (or cwd) so a runtime + ;; io/resource that wasn't embedded still resolves next to the binary. (put-string out "\n;; === launcher ===\n") + (put-string out "(suppress-greeting #t)\n") + (put-string out "(scheme-start\n (lambda args\n") + (bld-emit-natives out natives 'optional) + (put-string out (string-append + " (let ((base (or (getenv \"JOLT_PWD\") \".\")))\n" + " (set-source-roots!\n" + " (append (map (lambda (r) (string-append base \"/\" r)) (list " + (fold-left (lambda (s r) (string-append s (ei-str-lit r) " ")) "" (bld-strs ext-roots)) + "))\n" + " (list \"jolt-core\" \"stdlib\"))))\n")) (put-string out (string-append - "(suppress-greeting #t)\n" - "(scheme-start\n" - " (lambda args\n" " (let ((mainv (var-deref " (ei-str-lit entry-ns) " \"-main\")))\n" " (apply jolt-invoke mainv args))\n" " (exit 0)))\n")) @@ -233,8 +317,9 @@ (display (string-append "jolt build: wrote " out-path "\n")))))) (def-var! "jolt.host" "build-binary" - (lambda (entry out mode) + (lambda (entry out mode natives embed-dirs ext-roots) (build-binary (jolt-str-render-one entry) (jolt-str-render-one out) - (jolt-str-render-one mode)) + (jolt-str-render-one mode) + natives embed-dirs ext-roots) jolt-nil)) diff --git a/host/chez/ffi.ss b/host/chez/ffi.ss index c595b40..ca665e5 100644 --- a/host/chez/ffi.ss +++ b/host/chez/ffi.ss @@ -134,6 +134,24 @@ (when co (unlock-object co) (hashtable-delete! ffi-callable-table a)) jolt-nil)) +;; --- native libraries for a standalone binary ------------------------------- +;; `jolt build` bakes a project's deps.edn :jolt/native declarations into the +;; launcher, which loads them at startup (load-shared-object isn't part of the +;; saved heap, so it must run in the built process, not at heap build). process? +;; loads the running binary's own symbols (libc sockets); otherwise try each +;; platform candidate in turn and fail unless the spec is optional. +(define (jolt-build-load-native cands optional? process?) + (if process? + (begin (load-shared-object #f) #t) + (let loop ((cs cands)) + (cond + ((null? cs) + (unless optional? + (error 'jolt-build "required native library not found" cands)) + #f) + ((guard (e (#t #f)) (load-shared-object (car cs)) #t) #t) + (else (loop (cdr cs))))))) + ;; --- expose under jolt.ffi --------------------------------------------------- (def-var! "jolt.ffi" "free-callable" ffi-free-callable) (def-var! "jolt.ffi" "load-library" ffi-load-library) diff --git a/host/chez/io.ss b/host/chez/io.ss index 04ce13b..e8a84cf 100644 --- a/host/chez/io.ss +++ b/host/chez/io.ss @@ -19,6 +19,16 @@ ;; path string of any value: a jfile -> its path, else its str rendering. (define (file-path-of x) (if (jfile? x) (jfile-path x) (jolt-str-render-one x))) +;; Resources baked into a standalone binary by `jolt build` (deps.edn +;; :jolt/build :embed). The build emits a register-embedded-resource! per file at +;; heap-build time, so the contents live in the boot image — io/resource serves +;; them with no file on disk. An embedded hit reads through slurp/reader exactly +;; like a jfile would. +(define embedded-resources (make-hashtable equal-hash equal?)) +(define (register-embedded-resource! name content) + (hashtable-set! embedded-resources name content)) +(define-record-type embedded-res (fields name content) (nongenerative jolt-embres-v1)) + ;; A user-facing relative path resolves against JOLT_PWD — the user's cwd before ;; the launcher cd'd to the jolt repo root — matching the JVM, where io/file is ;; cwd-relative. (io/resource builds jfiles from the source roots directly, so it @@ -191,6 +201,7 @@ (define (jolt-slurp src . opts) (cond ((jfile? src) (read-file-string (jfile-path src))) + ((embedded-res? src) (embedded-res-content src)) ((reader-jhost? src) (drain-reader src)) ;; bytes (a bytevector or a jolt byte-array): decode with :encoding (UTF-8 ;; default). clj-http-lite slurps response-body byte arrays. @@ -286,6 +297,7 @@ (cond ((reader-jhost? x) x) ((jfile? x) (host-new "StringReader" (read-file-string (jfile-path x)))) + ((embedded-res? x) (host-new "StringReader" (embedded-res-content x))) ((and (jhost? x) (string=? (jhost-tag x) "url")) (host-new "StringReader" (read-file-string (url-strip-scheme (url-spec x))))) ((string? x) (host-new "StringReader" (read-file-string x))) @@ -317,11 +329,13 @@ ;; (slurp/reader-able) for the first match, else nil. get-source-roots is the ;; loader's accessor (loader.ss), resolved at call time — the runtime CLI loads it. (define (jolt-io-resource name) - (let ((nm (jolt-str-render-one name))) - (let loop ((roots (get-source-roots))) - (cond ((null? roots) jolt-nil) - ((file-exists? (string-append (car roots) "/" nm)) (make-jfile (string-append (car roots) "/" nm))) - (else (loop (cdr roots))))))) + (let* ((nm (jolt-str-render-one name)) + (emb (hashtable-ref embedded-resources nm #f))) + (if emb (make-embedded-res nm emb) + (let loop ((roots (get-source-roots))) + (cond ((null? roots) jolt-nil) + ((file-exists? (string-append (car roots) "/" nm)) (make-jfile (string-append (car roots) "/" nm))) + (else (loop (cdr roots)))))))) (def-var! "clojure.java.io" "resource" jolt-io-resource) ;; as-url honors a library-registered URL class (e.g. jolt-lang/http-client's full ;; java.net.URL shim) so io/as-url and (URL. spec) agree; else the file-only jhost. diff --git a/jolt-core/jolt/deps.clj b/jolt-core/jolt/deps.clj index e3dd000..343974e 100644 --- a/jolt-core/jolt/deps.clj +++ b/jolt-core/jolt/deps.clj @@ -127,6 +127,14 @@ {dep-roots :roots dep-natives :natives} (resolve-deps all-deps project-dir)] {:roots (vec (distinct (concat project-roots dep-roots))) :main-opts main-opts + ;; the project's own paths (relative to project-dir) and absolute resource + ;; roots, plus its :jolt/build options — `jolt build` uses these to bundle + ;; resources into / alongside a standalone binary. + :project-dir project-dir + :project-paths (vec project-paths) + :project-roots (vec project-roots) + :build (:jolt/build edn) + :embed-dirs (mapv #(abspath project-dir %) (:embed (:jolt/build edn))) :tasks (:tasks edn) :natives (vec (distinct (concat (:jolt/native edn) dep-natives))) ;; nREPL middleware a library contributes (jolt.nrepl composes them over its diff --git a/jolt-core/jolt/main.clj b/jolt-core/jolt/main.clj index 40e674a..7ab0aa3 100644 --- a/jolt-core/jolt/main.clj +++ b/jolt-core/jolt/main.clj @@ -8,6 +8,12 @@ (defn- project-dir [] (or (jolt.host/getenv "JOLT_PWD") ".")) +(defn- current-platform [] + (let [os (str/lower-case (or (System/getProperty "os.name") ""))] + (cond (str/includes? os "mac") :darwin + (str/includes? os "win") :windows + :else :linux))) + ;; Load a library's declared native shared objects (deps.edn :jolt/native) before ;; its Clojure is required, so its foreign-fn bindings resolve. Each entry is a ;; map: {:name "sqlite3" :darwin ["libsqlite3.0.dylib" ...] :linux ["libsqlite3.so.0" ...]} @@ -15,10 +21,7 @@ ;; (use the running process's symbols, e.g. libc sockets — no external file). (defn- load-natives! [natives] (when (seq natives) - (let [os (str/lower-case (or (System/getProperty "os.name") "")) - plat (cond (str/includes? os "mac") :darwin - (str/includes? os "win") :windows - :else :linux)] + (let [plat (current-platform)] (doseq [spec natives] (if (:process spec) (jolt.ffi/load-library) @@ -116,23 +119,41 @@ ;; standalone executable. Resolves deps + roots like `run`, then hands the entry ;; namespace to the host build driver (jolt.host/build-binary, defined by ;; build.ss). Default mode is release; --opt selects optimized, --dev unoptimized. +;; Encode a deps.edn :jolt/native spec for the build launcher, resolving the +;; current platform's candidate list now (the binary runs on this OS). Each entry +;; becomes a vector the launcher (build.ss) reads: ["process"] for the running +;; binary's own symbols, else ["req"|"opt" cand…] to try in turn. +(defn- encode-natives [natives] + (let [plat (current-platform)] + (vec (for [spec natives] + (if (:process spec) + ["process"] + (let [c (get spec plat) + cands (if (string? c) [c] (vec c))] + (into [(if (:optional spec) "opt" "req")] cands))))))) + (defn- cmd-build [more] - (apply-project! (deps/resolve-project (project-dir))) - (let [opts (loop [a more, entry nil, out nil] - (cond - (empty? a) {:entry entry :out out} - (= "-m" (first a)) (recur (drop 2 a) (second a) out) - (= "-o" (first a)) (recur (drop 2 a) entry (second a)) - (str/starts-with? (first a) "-") (recur (rest a) entry out) - :else (recur (rest a) (or entry (first a)) out))) - entry (:entry opts) - mode (cond (some #{"--opt"} more) "optimized" - (some #{"--dev"} more) "dev" - :else "release")] - (when (nil? entry) - (throw (ex-info "build needs an entry: -m NS" {}))) - (let [out (or (:out opts) (first (str/split entry #"\.")))] - (jolt.host/build-binary entry out mode)))) + (let [{:keys [project-paths embed-dirs] :as resolved} + (deps/resolve-project (project-dir))] + (apply-project! resolved) + (let [opts (loop [a more, entry nil, out nil] + (cond + (empty? a) {:entry entry :out out} + (= "-m" (first a)) (recur (drop 2 a) (second a) out) + (= "-o" (first a)) (recur (drop 2 a) entry (second a)) + (str/starts-with? (first a) "-") (recur (rest a) entry out) + :else (recur (rest a) (or entry (first a)) out))) + entry (:entry opts) + mode (cond (some #{"--opt"} more) "optimized" + (some #{"--dev"} more) "dev" + :else "release")] + (when (nil? entry) + (throw (ex-info "build needs an entry: -m NS" {}))) + (let [out (or (:out opts) (first (str/split entry #"\."))) + natives (encode-natives (:natives resolved))] + ;; embed-dirs (absolute) are walked + baked into the binary by the driver; + ;; project-paths (relative) become runtime io/resource roots (ship-alongside). + (jolt.host/build-binary entry out mode natives embed-dirs project-paths))))) (defn- nrepl [more] ;; resolve the project (deps on the roots, native libs loaded), then start the diff --git a/test/chez/build-app/deps.edn b/test/chez/build-app/deps.edn index ccd9a31..fff0290 100644 --- a/test/chez/build-app/deps.edn +++ b/test/chez/build-app/deps.edn @@ -1 +1,8 @@ -{:paths ["src"]} +{:paths ["src" "resources"] + + ;; exercise the build's native-lib loading: a :process spec loads the running + ;; binary's own symbols (libc) at startup — no external file, always succeeds. + :jolt/native [{:name "libc" :process true}] + + ;; bake resources/ into the binary so io/resource resolves with no file on disk. + :jolt/build {:embed ["resources"]}} diff --git a/test/chez/build-app/resources/greeting.txt b/test/chez/build-app/resources/greeting.txt new file mode 100644 index 0000000..835112d --- /dev/null +++ b/test/chez/build-app/resources/greeting.txt @@ -0,0 +1 @@ +embedded resource ok \ No newline at end of file diff --git a/test/chez/build-app/src/app/core.clj b/test/chez/build-app/src/app/core.clj index 4fd95a0..fd50bba 100644 --- a/test/chez/build-app/src/app/core.clj +++ b/test/chez/build-app/src/app/core.clj @@ -1,7 +1,11 @@ (ns app.core - (:require [app.util :as util])) + (:require [app.util :as util] + [clojure.java.io :as io])) (defn -main [& args] + ;; the resource is baked into the binary (deps.edn :jolt/build :embed), so this + ;; resolves with no resources/ dir on disk, run from any cwd. + (println (slurp (io/resource "greeting.txt"))) (util/twice (println (util/shout "hello from a built binary"))) (println "args:" (vec args)) (println "sum:" (reduce + (map count args))))