diff --git a/host/chez/emit-image.ss b/host/chez/emit-image.ss index 0374d22..7bc6ea0 100644 --- a/host/chez/emit-image.ss +++ b/host/chez/emit-image.ss @@ -130,6 +130,7 @@ (cons "jolt.passes.numeric" "jolt-core/jolt/passes/numeric.clj") (cons "jolt.passes.inline" "jolt-core/jolt/passes/inline.clj") (cons "jolt.passes.types.lattice" "jolt-core/jolt/passes/types/lattice.clj") + (cons "jolt.passes.types.check" "jolt-core/jolt/passes/types/check.clj") (cons "jolt.passes.types" "jolt-core/jolt/passes/types.clj") (cons "jolt.passes" "jolt-core/jolt/passes.clj"))) diff --git a/host/chez/seed/image.ss b/host/chez/seed/image.ss index 8f34f5d..a6c681a 100644 --- a/host/chez/seed/image.ss +++ b/host/chez/seed/image.ss @@ -359,63 +359,79 @@ (guard (e (#t #f)) (def-var! "jolt.passes.inline" "scalar-replace" (letrec ((scalar-replace (lambda (node) (let fnrec3973 ((node node)) (let* ((op (jolt-get node (keyword #f "op")))) (if (jolt= op (keyword #f "invoke")) (jolt-invoke (var-deref "jolt.passes.inline" "fold-kw-literal") (jolt-invoke (var-deref "jolt.ir" "map-ir-children") scalar-replace node)) (if (jolt= op (keyword #f "let")) (jolt-invoke (var-deref "jolt.passes.inline" "elim-let-structs") (jolt-invoke (var-deref "jolt.ir" "map-ir-children") scalar-replace node)) (if (jolt-truthy? (keyword #f "else")) (jolt-invoke (var-deref "jolt.ir" "map-ir-children") scalar-replace node) jolt-nil)))))))) scalar-replace))) (guard (e (#t #f)) - (def-var! "jolt.passes.types.lattice" "velem" (letrec ((velem (lambda (t) (let fnrec2895 ((t t)) (jolt-get t (keyword #f "vec")))))) velem))) + (def-var! "jolt.passes.types.lattice" "velem" (letrec ((velem (lambda (t) (let fnrec3374 ((t t)) (jolt-get t (keyword #f "vec")))))) velem))) (guard (e (#t #f)) - (def-var! "jolt.passes.types.lattice" "selem" (letrec ((selem (lambda (t) (let fnrec2896 ((t t)) (jolt-get t (keyword #f "set")))))) selem))) + (def-var! "jolt.passes.types.lattice" "selem" (letrec ((selem (lambda (t) (let fnrec3375 ((t t)) (jolt-get t (keyword #f "set")))))) selem))) (guard (e (#t #f)) - (def-var! "jolt.passes.types.lattice" "sfields" (letrec ((sfields (lambda (t) (let fnrec2897 ((t t)) (jolt-get t (keyword #f "struct")))))) sfields))) + (def-var! "jolt.passes.types.lattice" "sfields" (letrec ((sfields (lambda (t) (let fnrec3376 ((t t)) (jolt-get t (keyword #f "struct")))))) sfields))) (guard (e (#t #f)) - (def-var! "jolt.passes.types.lattice" "vec-type?" (letrec ((vec-type? (lambda (t) (let fnrec2898 ((t t)) (jolt-invoke (var-deref "clojure.core" "some?") (jolt-invoke (var-deref "jolt.passes.types.lattice" "velem") t)))))) vec-type?))) + (def-var! "jolt.passes.types.lattice" "vec-type?" (letrec ((vec-type? (lambda (t) (let fnrec3377 ((t t)) (jolt-invoke (var-deref "clojure.core" "some?") (jolt-invoke (var-deref "jolt.passes.types.lattice" "velem") t)))))) vec-type?))) (guard (e (#t #f)) - (def-var! "jolt.passes.types.lattice" "set-type?" (letrec ((set-type? (lambda (t) (let fnrec2899 ((t t)) (jolt-invoke (var-deref "clojure.core" "some?") (jolt-invoke (var-deref "jolt.passes.types.lattice" "selem") t)))))) set-type?))) + (def-var! "jolt.passes.types.lattice" "set-type?" (letrec ((set-type? (lambda (t) (let fnrec3378 ((t t)) (jolt-invoke (var-deref "clojure.core" "some?") (jolt-invoke (var-deref "jolt.passes.types.lattice" "selem") t)))))) set-type?))) (guard (e (#t #f)) - (def-var! "jolt.passes.types.lattice" "struct-type?" (letrec ((struct-type? (lambda (t) (let fnrec2900 ((t t)) (jolt-invoke (var-deref "clojure.core" "some?") (jolt-invoke (var-deref "jolt.passes.types.lattice" "sfields") t)))))) struct-type?))) + (def-var! "jolt.passes.types.lattice" "struct-type?" (letrec ((struct-type? (lambda (t) (let fnrec3379 ((t t)) (jolt-invoke (var-deref "clojure.core" "some?") (jolt-invoke (var-deref "jolt.passes.types.lattice" "sfields") t)))))) struct-type?))) (guard (e (#t #f)) - (def-var! "jolt.passes.types.lattice" "mk-vec" (letrec ((mk-vec (lambda (t) (let fnrec2901 ((t t)) (let* ((_o$2902 (keyword #f "vec")) (_o$2903 (if (jolt-truthy? t) t (keyword #f "any")))) (jolt-hash-map _o$2902 _o$2903)))))) mk-vec))) + (def-var! "jolt.passes.types.lattice" "mk-vec" (letrec ((mk-vec (lambda (t) (let fnrec3380 ((t t)) (let* ((_o$3381 (keyword #f "vec")) (_o$3382 (if (jolt-truthy? t) t (keyword #f "any")))) (jolt-hash-map _o$3381 _o$3382)))))) mk-vec))) (guard (e (#t #f)) - (def-var! "jolt.passes.types.lattice" "mk-set" (letrec ((mk-set (lambda (t) (let fnrec2904 ((t t)) (let* ((_o$2905 (keyword #f "set")) (_o$2906 (if (jolt-truthy? t) t (keyword #f "any")))) (jolt-hash-map _o$2905 _o$2906)))))) mk-set))) + (def-var! "jolt.passes.types.lattice" "mk-set" (letrec ((mk-set (lambda (t) (let fnrec3383 ((t t)) (let* ((_o$3384 (keyword #f "set")) (_o$3385 (if (jolt-truthy? t) t (keyword #f "any")))) (jolt-hash-map _o$3384 _o$3385)))))) mk-set))) (guard (e (#t #f)) - (def-var! "jolt.passes.types.lattice" "mk-struct" (letrec ((mk-struct (lambda (fs) (let fnrec2907 ((fs fs)) (let* ((_o$2908 (keyword #f "struct")) (_o$2909 fs)) (jolt-hash-map _o$2908 _o$2909)))))) mk-struct))) + (def-var! "jolt.passes.types.lattice" "mk-struct" (letrec ((mk-struct (lambda (fs) (let fnrec3386 ((fs fs)) (let* ((_o$3387 (keyword #f "struct")) (_o$3388 fs)) (jolt-hash-map _o$3387 _o$3388)))))) mk-struct))) (guard (e (#t #f)) (def-var! "jolt.passes.types.lattice" "union-cap" 4)) (guard (e (#t #f)) - (def-var! "jolt.passes.types.lattice" "scalar-t?" (letrec ((scalar-t? (lambda (t) (let fnrec2910 ((t t)) (let* ((or__14__auto (jolt= t (keyword #f "num")))) (if (jolt-truthy? or__14__auto) or__14__auto (let* ((or__14__auto (jolt= t (keyword #f "str")))) (if (jolt-truthy? or__14__auto) or__14__auto (let* ((or__14__auto (jolt= t (keyword #f "kw")))) (if (jolt-truthy? or__14__auto) or__14__auto (let* ((or__14__auto (jolt= t (keyword #f "truthy")))) (if (jolt-truthy? or__14__auto) or__14__auto (jolt= t (keyword #f "phm")))))))))))))) scalar-t?))) + (def-var! "jolt.passes.types.lattice" "scalar-t?" (letrec ((scalar-t? (lambda (t) (let fnrec3389 ((t t)) (let* ((or__14__auto (jolt= t (keyword #f "num")))) (if (jolt-truthy? or__14__auto) or__14__auto (let* ((or__14__auto (jolt= t (keyword #f "str")))) (if (jolt-truthy? or__14__auto) or__14__auto (let* ((or__14__auto (jolt= t (keyword #f "kw")))) (if (jolt-truthy? or__14__auto) or__14__auto (let* ((or__14__auto (jolt= t (keyword #f "truthy")))) (if (jolt-truthy? or__14__auto) or__14__auto (jolt= t (keyword #f "phm")))))))))))))) scalar-t?))) (guard (e (#t #f)) - (def-var! "jolt.passes.types.lattice" "union-type?" (letrec ((union-type? (lambda (t) (let fnrec2911 ((t t)) (jolt-invoke (var-deref "clojure.core" "some?") (jolt-get t (keyword #f "union"))))))) union-type?))) + (def-var! "jolt.passes.types.lattice" "union-type?" (letrec ((union-type? (lambda (t) (let fnrec3390 ((t t)) (jolt-invoke (var-deref "clojure.core" "some?") (jolt-get t (keyword #f "union"))))))) union-type?))) (guard (e (#t #f)) - (def-var! "jolt.passes.types.lattice" "umembers" (letrec ((umembers (lambda (t) (let fnrec2912 ((t t)) (jolt-get t (keyword #f "union")))))) umembers))) + (def-var! "jolt.passes.types.lattice" "umembers" (letrec ((umembers (lambda (t) (let fnrec3391 ((t t)) (jolt-get t (keyword #f "union")))))) umembers))) (guard (e (#t #f)) - (def-var! "jolt.passes.types.lattice" "union-of" (letrec ((union-of (lambda (ts) (let fnrec2913 ((ts ts)) (let* ((flat (let* ((_a$2915 (lambda (acc t) (let fnrec2914 ((acc acc) (t t)) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.passes.types.lattice" "union-type?") t)) (jolt-reduce jolt-conj acc (jolt-invoke (var-deref "jolt.passes.types.lattice" "umembers") t)) (jolt-conj acc t))))) (_a$2916 (jolt-hash-set)) (_a$2917 ts)) (jolt-reduce _a$2915 _a$2916 _a$2917)))) (if (jolt-not (jolt-invoke (var-deref "clojure.core" "every?") (var-deref "jolt.passes.types.lattice" "scalar-t?") flat)) (keyword #f "any") (if (jolt= 0 (jolt-count flat)) (keyword #f "any") (if (jolt= 1 (jolt-count flat)) (jolt-first flat) (if (> (jolt-count flat) (var-deref "jolt.passes.types.lattice" "union-cap")) (keyword #f "any") (if (jolt-truthy? (keyword #f "else")) (let* ((_o$2918 (keyword #f "union")) (_o$2919 flat)) (jolt-hash-map _o$2918 _o$2919)) jolt-nil)))))))))) union-of))) + (def-var! "jolt.passes.types.lattice" "union-of" (letrec ((union-of (lambda (ts) (let fnrec3392 ((ts ts)) (let* ((flat (let* ((_a$3394 (lambda (acc t) (let fnrec3393 ((acc acc) (t t)) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.passes.types.lattice" "union-type?") t)) (jolt-reduce jolt-conj acc (jolt-invoke (var-deref "jolt.passes.types.lattice" "umembers") t)) (jolt-conj acc t))))) (_a$3395 (jolt-hash-set)) (_a$3396 ts)) (jolt-reduce _a$3394 _a$3395 _a$3396)))) (if (jolt-not (jolt-invoke (var-deref "clojure.core" "every?") (var-deref "jolt.passes.types.lattice" "scalar-t?") flat)) (keyword #f "any") (if (jolt= 0 (jolt-count flat)) (keyword #f "any") (if (jolt= 1 (jolt-count flat)) (jolt-first flat) (if (> (jolt-count flat) (var-deref "jolt.passes.types.lattice" "union-cap")) (keyword #f "any") (if (jolt-truthy? (keyword #f "else")) (let* ((_o$3397 (keyword #f "union")) (_o$3398 flat)) (jolt-hash-map _o$3397 _o$3398)) jolt-nil)))))))))) union-of))) (guard (e (#t #f)) (declare-var! "jolt.passes.types.lattice" "join-t")) (guard (e (#t #f)) - (def-var! "jolt.passes.types.lattice" "merge-fields" (letrec ((merge-fields (lambda (fa fb) (let fnrec2920 ((fa fa) (fb fb)) (let* ((m1 (let* ((_a$2925 (lambda (m k) (let fnrec2921 ((m m) (k k)) (jolt-assoc m k (let* ((_a$2922 (var-deref "jolt.passes.types.lattice" "join-t")) (_a$2923 (jolt-get fa k (keyword #f "any"))) (_a$2924 (jolt-get fb k (keyword #f "any")))) (jolt-invoke _a$2922 _a$2923 _a$2924)))))) (_a$2926 (jolt-hash-map)) (_a$2927 (jolt-keys fa))) (jolt-reduce _a$2925 _a$2926 _a$2927)))) (let* ((_a$2932 (lambda (m k) (let fnrec2928 ((m m) (k k)) (if (jolt-truthy? (jolt-get m k)) m (jolt-assoc m k (let* ((_a$2929 (var-deref "jolt.passes.types.lattice" "join-t")) (_a$2930 (jolt-get fa k (keyword #f "any"))) (_a$2931 (jolt-get fb k (keyword #f "any")))) (jolt-invoke _a$2929 _a$2930 _a$2931))))))) (_a$2933 m1) (_a$2934 (jolt-keys fb))) (jolt-reduce _a$2932 _a$2933 _a$2934))))))) merge-fields))) + (def-var! "jolt.passes.types.lattice" "merge-fields" (letrec ((merge-fields (lambda (fa fb) (let fnrec3399 ((fa fa) (fb fb)) (let* ((m1 (let* ((_a$3404 (lambda (m k) (let fnrec3400 ((m m) (k k)) (jolt-assoc m k (let* ((_a$3401 (var-deref "jolt.passes.types.lattice" "join-t")) (_a$3402 (jolt-get fa k (keyword #f "any"))) (_a$3403 (jolt-get fb k (keyword #f "any")))) (jolt-invoke _a$3401 _a$3402 _a$3403)))))) (_a$3405 (jolt-hash-map)) (_a$3406 (jolt-keys fa))) (jolt-reduce _a$3404 _a$3405 _a$3406)))) (let* ((_a$3411 (lambda (m k) (let fnrec3407 ((m m) (k k)) (if (jolt-truthy? (jolt-get m k)) m (jolt-assoc m k (let* ((_a$3408 (var-deref "jolt.passes.types.lattice" "join-t")) (_a$3409 (jolt-get fa k (keyword #f "any"))) (_a$3410 (jolt-get fb k (keyword #f "any")))) (jolt-invoke _a$3408 _a$3409 _a$3410))))))) (_a$3412 m1) (_a$3413 (jolt-keys fb))) (jolt-reduce _a$3411 _a$3412 _a$3413))))))) merge-fields))) (guard (e (#t #f)) - (def-var! "jolt.passes.types.lattice" "join-t" (letrec ((join-t (lambda (a b) (let fnrec2935 ((a a) (b b)) (if (jolt= a b) a (if (jolt-truthy? (jolt-invoke (var-deref "clojure.core" "nil?") a)) b (if (jolt-truthy? (jolt-invoke (var-deref "clojure.core" "nil?") b)) a (if (jolt-truthy? (let* ((and__13__auto (jolt-invoke (var-deref "jolt.passes.types.lattice" "struct-type?") a))) (if (jolt-truthy? and__13__auto) (jolt-invoke (var-deref "jolt.passes.types.lattice" "struct-type?") b) and__13__auto))) (let* ((merged (jolt-invoke (var-deref "jolt.passes.types.lattice" "mk-struct") (let* ((_a$2936 (var-deref "jolt.passes.types.lattice" "merge-fields")) (_a$2937 (jolt-invoke (var-deref "jolt.passes.types.lattice" "sfields") a)) (_a$2938 (jolt-invoke (var-deref "jolt.passes.types.lattice" "sfields") b))) (jolt-invoke _a$2936 _a$2937 _a$2938))))) (if (jolt-truthy? (let* ((and__13__auto (jolt-get a (keyword #f "shape")))) (if (jolt-truthy? and__13__auto) (let* ((_a$2939 (jolt-get a (keyword #f "shape"))) (_a$2940 (jolt-get b (keyword #f "shape")))) (jolt= _a$2939 _a$2940)) and__13__auto))) (jolt-assoc merged (keyword #f "shape") (jolt-get a (keyword #f "shape"))) merged)) (if (jolt-truthy? (let* ((and__13__auto (jolt-invoke (var-deref "jolt.passes.types.lattice" "vec-type?") a))) (if (jolt-truthy? and__13__auto) (jolt-invoke (var-deref "jolt.passes.types.lattice" "vec-type?") b) and__13__auto))) (jolt-invoke (var-deref "jolt.passes.types.lattice" "mk-vec") (let* ((_a$2941 join-t) (_a$2942 (jolt-invoke (var-deref "jolt.passes.types.lattice" "velem") a)) (_a$2943 (jolt-invoke (var-deref "jolt.passes.types.lattice" "velem") b))) (jolt-invoke _a$2941 _a$2942 _a$2943))) (if (jolt-truthy? (let* ((and__13__auto (jolt-invoke (var-deref "jolt.passes.types.lattice" "set-type?") a))) (if (jolt-truthy? and__13__auto) (jolt-invoke (var-deref "jolt.passes.types.lattice" "set-type?") b) and__13__auto))) (jolt-invoke (var-deref "jolt.passes.types.lattice" "mk-set") (let* ((_a$2944 join-t) (_a$2945 (jolt-invoke (var-deref "jolt.passes.types.lattice" "selem") a)) (_a$2946 (jolt-invoke (var-deref "jolt.passes.types.lattice" "selem") b))) (jolt-invoke _a$2944 _a$2945 _a$2946))) (if (jolt-truthy? (keyword #f "else")) (let* ((ma (if (jolt-truthy? (jolt-invoke (var-deref "jolt.passes.types.lattice" "union-type?") a)) (jolt-invoke (var-deref "jolt.passes.types.lattice" "umembers") a) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.passes.types.lattice" "scalar-t?") a)) (jolt-hash-set a) (if (jolt-truthy? (keyword #f "else")) jolt-nil jolt-nil)))) (mb (if (jolt-truthy? (jolt-invoke (var-deref "jolt.passes.types.lattice" "union-type?") b)) (jolt-invoke (var-deref "jolt.passes.types.lattice" "umembers") b) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.passes.types.lattice" "scalar-t?") b)) (jolt-hash-set b) (if (jolt-truthy? (keyword #f "else")) jolt-nil jolt-nil))))) (if (jolt-truthy? (let* ((and__13__auto ma)) (if (jolt-truthy? and__13__auto) mb and__13__auto))) (jolt-invoke (var-deref "jolt.passes.types.lattice" "union-of") (jolt-reduce jolt-conj ma mb)) (keyword #f "any"))) jolt-nil))))))))))) join-t))) + (def-var! "jolt.passes.types.lattice" "join-t" (letrec ((join-t (lambda (a b) (let fnrec3414 ((a a) (b b)) (if (jolt= a b) a (if (jolt-truthy? (jolt-invoke (var-deref "clojure.core" "nil?") a)) b (if (jolt-truthy? (jolt-invoke (var-deref "clojure.core" "nil?") b)) a (if (jolt-truthy? (let* ((and__13__auto (jolt-invoke (var-deref "jolt.passes.types.lattice" "struct-type?") a))) (if (jolt-truthy? and__13__auto) (jolt-invoke (var-deref "jolt.passes.types.lattice" "struct-type?") b) and__13__auto))) (let* ((merged (jolt-invoke (var-deref "jolt.passes.types.lattice" "mk-struct") (let* ((_a$3415 (var-deref "jolt.passes.types.lattice" "merge-fields")) (_a$3416 (jolt-invoke (var-deref "jolt.passes.types.lattice" "sfields") a)) (_a$3417 (jolt-invoke (var-deref "jolt.passes.types.lattice" "sfields") b))) (jolt-invoke _a$3415 _a$3416 _a$3417))))) (if (jolt-truthy? (let* ((and__13__auto (jolt-get a (keyword #f "shape")))) (if (jolt-truthy? and__13__auto) (let* ((_a$3418 (jolt-get a (keyword #f "shape"))) (_a$3419 (jolt-get b (keyword #f "shape")))) (jolt= _a$3418 _a$3419)) and__13__auto))) (jolt-assoc merged (keyword #f "shape") (jolt-get a (keyword #f "shape"))) merged)) (if (jolt-truthy? (let* ((and__13__auto (jolt-invoke (var-deref "jolt.passes.types.lattice" "vec-type?") a))) (if (jolt-truthy? and__13__auto) (jolt-invoke (var-deref "jolt.passes.types.lattice" "vec-type?") b) and__13__auto))) (jolt-invoke (var-deref "jolt.passes.types.lattice" "mk-vec") (let* ((_a$3420 join-t) (_a$3421 (jolt-invoke (var-deref "jolt.passes.types.lattice" "velem") a)) (_a$3422 (jolt-invoke (var-deref "jolt.passes.types.lattice" "velem") b))) (jolt-invoke _a$3420 _a$3421 _a$3422))) (if (jolt-truthy? (let* ((and__13__auto (jolt-invoke (var-deref "jolt.passes.types.lattice" "set-type?") a))) (if (jolt-truthy? and__13__auto) (jolt-invoke (var-deref "jolt.passes.types.lattice" "set-type?") b) and__13__auto))) (jolt-invoke (var-deref "jolt.passes.types.lattice" "mk-set") (let* ((_a$3423 join-t) (_a$3424 (jolt-invoke (var-deref "jolt.passes.types.lattice" "selem") a)) (_a$3425 (jolt-invoke (var-deref "jolt.passes.types.lattice" "selem") b))) (jolt-invoke _a$3423 _a$3424 _a$3425))) (if (jolt-truthy? (keyword #f "else")) (let* ((ma (if (jolt-truthy? (jolt-invoke (var-deref "jolt.passes.types.lattice" "union-type?") a)) (jolt-invoke (var-deref "jolt.passes.types.lattice" "umembers") a) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.passes.types.lattice" "scalar-t?") a)) (jolt-hash-set a) (if (jolt-truthy? (keyword #f "else")) jolt-nil jolt-nil)))) (mb (if (jolt-truthy? (jolt-invoke (var-deref "jolt.passes.types.lattice" "union-type?") b)) (jolt-invoke (var-deref "jolt.passes.types.lattice" "umembers") b) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.passes.types.lattice" "scalar-t?") b)) (jolt-hash-set b) (if (jolt-truthy? (keyword #f "else")) jolt-nil jolt-nil))))) (if (jolt-truthy? (let* ((and__13__auto ma)) (if (jolt-truthy? and__13__auto) mb and__13__auto))) (jolt-invoke (var-deref "jolt.passes.types.lattice" "union-of") (jolt-reduce jolt-conj ma mb)) (keyword #f "any"))) jolt-nil))))))))))) join-t))) (guard (e (#t #f)) - (def-var! "jolt.passes.types.lattice" "join" (letrec ((join (lambda (a b) (let fnrec2947 ((a a) (b b)) (jolt-invoke (var-deref "jolt.passes.types.lattice" "join-t") a b))))) join))) + (def-var! "jolt.passes.types.lattice" "join" (letrec ((join (lambda (a b) (let fnrec3426 ((a a) (b b)) (jolt-invoke (var-deref "jolt.passes.types.lattice" "join-t") a b))))) join))) (guard (e (#t #f)) (def-var! "jolt.passes.types.lattice" "type-depth" 4)) (guard (e (#t #f)) - (def-var! "jolt.passes.types.lattice" "cap" (letrec ((cap (lambda (t d) (let fnrec2948 ((t t) (d d)) (if (<= d 0) (if (jolt-truthy? (let* ((or__14__auto (jolt-invoke (var-deref "jolt.passes.types.lattice" "struct-type?") t))) (if (jolt-truthy? or__14__auto) or__14__auto (let* ((or__14__auto (jolt-invoke (var-deref "jolt.passes.types.lattice" "vec-type?") t))) (if (jolt-truthy? or__14__auto) or__14__auto (jolt-invoke (var-deref "jolt.passes.types.lattice" "set-type?") t)))))) (keyword #f "any") t) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.passes.types.lattice" "struct-type?") t)) (let* ((capped (jolt-invoke (var-deref "jolt.passes.types.lattice" "mk-struct") (let* ((_a$2953 (lambda (m k) (let fnrec2949 ((m m) (k k)) (jolt-assoc m k (let* ((_a$2950 cap) (_a$2951 (jolt-get (jolt-invoke (var-deref "jolt.passes.types.lattice" "sfields") t) k)) (_a$2952 (jolt-dec d))) (jolt-invoke _a$2950 _a$2951 _a$2952)))))) (_a$2954 (jolt-hash-map)) (_a$2955 (jolt-keys (jolt-invoke (var-deref "jolt.passes.types.lattice" "sfields") t)))) (jolt-reduce _a$2953 _a$2954 _a$2955)))) (capped (if (jolt-truthy? (jolt-get t (keyword #f "shape"))) (jolt-assoc capped (keyword #f "shape") (jolt-get t (keyword #f "shape"))) capped)) (capped (if (jolt-truthy? (jolt-get t (keyword #f "type"))) (jolt-assoc capped (keyword #f "type") (jolt-get t (keyword #f "type"))) capped))) capped) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.passes.types.lattice" "vec-type?") t)) (jolt-invoke (var-deref "jolt.passes.types.lattice" "mk-vec") (let* ((_a$2956 cap) (_a$2957 (jolt-invoke (var-deref "jolt.passes.types.lattice" "velem") t)) (_a$2958 (jolt-dec d))) (jolt-invoke _a$2956 _a$2957 _a$2958))) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.passes.types.lattice" "set-type?") t)) (jolt-invoke (var-deref "jolt.passes.types.lattice" "mk-set") (let* ((_a$2959 cap) (_a$2960 (jolt-invoke (var-deref "jolt.passes.types.lattice" "selem") t)) (_a$2961 (jolt-dec d))) (jolt-invoke _a$2959 _a$2960 _a$2961))) (if (jolt-truthy? (keyword #f "else")) t jolt-nil))))))))) cap))) + (def-var! "jolt.passes.types.lattice" "cap" (letrec ((cap (lambda (t d) (let fnrec3427 ((t t) (d d)) (if (<= d 0) (if (jolt-truthy? (let* ((or__14__auto (jolt-invoke (var-deref "jolt.passes.types.lattice" "struct-type?") t))) (if (jolt-truthy? or__14__auto) or__14__auto (let* ((or__14__auto (jolt-invoke (var-deref "jolt.passes.types.lattice" "vec-type?") t))) (if (jolt-truthy? or__14__auto) or__14__auto (jolt-invoke (var-deref "jolt.passes.types.lattice" "set-type?") t)))))) (keyword #f "any") t) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.passes.types.lattice" "struct-type?") t)) (let* ((capped (jolt-invoke (var-deref "jolt.passes.types.lattice" "mk-struct") (let* ((_a$3432 (lambda (m k) (let fnrec3428 ((m m) (k k)) (jolt-assoc m k (let* ((_a$3429 cap) (_a$3430 (jolt-get (jolt-invoke (var-deref "jolt.passes.types.lattice" "sfields") t) k)) (_a$3431 (jolt-dec d))) (jolt-invoke _a$3429 _a$3430 _a$3431)))))) (_a$3433 (jolt-hash-map)) (_a$3434 (jolt-keys (jolt-invoke (var-deref "jolt.passes.types.lattice" "sfields") t)))) (jolt-reduce _a$3432 _a$3433 _a$3434)))) (capped (if (jolt-truthy? (jolt-get t (keyword #f "shape"))) (jolt-assoc capped (keyword #f "shape") (jolt-get t (keyword #f "shape"))) capped)) (capped (if (jolt-truthy? (jolt-get t (keyword #f "type"))) (jolt-assoc capped (keyword #f "type") (jolt-get t (keyword #f "type"))) capped))) capped) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.passes.types.lattice" "vec-type?") t)) (jolt-invoke (var-deref "jolt.passes.types.lattice" "mk-vec") (let* ((_a$3435 cap) (_a$3436 (jolt-invoke (var-deref "jolt.passes.types.lattice" "velem") t)) (_a$3437 (jolt-dec d))) (jolt-invoke _a$3435 _a$3436 _a$3437))) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.passes.types.lattice" "set-type?") t)) (jolt-invoke (var-deref "jolt.passes.types.lattice" "mk-set") (let* ((_a$3438 cap) (_a$3439 (jolt-invoke (var-deref "jolt.passes.types.lattice" "selem") t)) (_a$3440 (jolt-dec d))) (jolt-invoke _a$3438 _a$3439 _a$3440))) (if (jolt-truthy? (keyword #f "else")) t jolt-nil))))))))) cap))) (guard (e (#t #f)) - (def-var! "jolt.passes.types.lattice" "struct-safe?" (letrec ((struct-safe? (lambda (t) (let fnrec2962 ((t t)) (jolt-invoke (var-deref "jolt.passes.types.lattice" "struct-type?") t))))) struct-safe?))) + (def-var! "jolt.passes.types.lattice" "struct-safe?" (letrec ((struct-safe? (lambda (t) (let fnrec3441 ((t t)) (jolt-invoke (var-deref "jolt.passes.types.lattice" "struct-type?") t))))) struct-safe?))) (guard (e (#t #f)) - (def-var! "jolt.passes.types.lattice" "field-type" (letrec ((field-type (lambda (t k) (let fnrec2963 ((t t) (k k)) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.passes.types.lattice" "struct-type?") t)) (jolt-get (jolt-invoke (var-deref "jolt.passes.types.lattice" "sfields") t) k (keyword #f "any")) (keyword #f "any")))))) field-type))) + (def-var! "jolt.passes.types.lattice" "field-type" (letrec ((field-type (lambda (t k) (let fnrec3442 ((t t) (k k)) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.passes.types.lattice" "struct-type?") t)) (jolt-get (jolt-invoke (var-deref "jolt.passes.types.lattice" "sfields") t) k (keyword #f "any")) (keyword #f "any")))))) field-type))) (guard (e (#t #f)) - (def-var! "jolt.passes.types.lattice" "shape-order" (letrec ((shape-order (lambda (ks) (let fnrec2964 ((ks ks)) (jolt-invoke (var-deref "clojure.core" "vec") (jolt-invoke (var-deref "clojure.core" "sort") (lambda (a b) (let fnrec2965 ((a a) (b b)) (let* ((_a$2966 (var-deref "clojure.core" "compare")) (_a$2967 (jolt-invoke (var-deref "clojure.core" "str") a)) (_a$2968 (jolt-invoke (var-deref "clojure.core" "str") b))) (jolt-invoke _a$2966 _a$2967 _a$2968)))) ks)))))) shape-order))) + (def-var! "jolt.passes.types.lattice" "shape-order" (letrec ((shape-order (lambda (ks) (let fnrec3443 ((ks ks)) (jolt-invoke (var-deref "clojure.core" "vec") (jolt-invoke (var-deref "clojure.core" "sort") (lambda (a b) (let fnrec3444 ((a a) (b b)) (let* ((_a$3445 (var-deref "clojure.core" "compare")) (_a$3446 (jolt-invoke (var-deref "clojure.core" "str") a)) (_a$3447 (jolt-invoke (var-deref "clojure.core" "str") b))) (jolt-invoke _a$3445 _a$3446 _a$3447)))) ks)))))) shape-order))) (guard (e (#t #f)) - (def-var! "jolt.passes.types.lattice" "type-shape" (letrec ((type-shape (lambda (t) (let fnrec2969 ((t t)) (jolt-get t (keyword #f "shape")))))) type-shape))) + (def-var! "jolt.passes.types.lattice" "type-shape" (letrec ((type-shape (lambda (t) (let fnrec3448 ((t t)) (jolt-get t (keyword #f "shape")))))) type-shape))) (guard (e (#t #f)) - (def-var! "jolt.passes.types.lattice" "mark-struct" (letrec ((mark-struct (lambda (node t) (let fnrec2970 ((node node) (t t)) (let* ((n (jolt-assoc node (keyword #f "hint") (keyword #f "struct")))) (if (jolt-truthy? (jolt-get t (keyword #f "shape"))) (jolt-assoc n (keyword #f "shape") (jolt-get t (keyword #f "shape"))) n)))))) mark-struct))) + (def-var! "jolt.passes.types.lattice" "mark-struct" (letrec ((mark-struct (lambda (node t) (let fnrec3449 ((node node) (t t)) (let* ((n (jolt-assoc node (keyword #f "hint") (keyword #f "struct")))) (if (jolt-truthy? (jolt-get t (keyword #f "shape"))) (jolt-assoc n (keyword #f "shape") (jolt-get t (keyword #f "shape"))) n)))))) mark-struct))) (guard (e (#t #f)) - (def-var! "jolt.passes.types.lattice" "truthy-type?" (letrec ((truthy-type? (lambda (t) (let fnrec2971 ((t t)) (let* ((or__14__auto (jolt= t (keyword #f "num")))) (if (jolt-truthy? or__14__auto) or__14__auto (let* ((or__14__auto (jolt= t (keyword #f "str")))) (if (jolt-truthy? or__14__auto) or__14__auto (let* ((or__14__auto (jolt= t (keyword #f "kw")))) (if (jolt-truthy? or__14__auto) or__14__auto (let* ((or__14__auto (jolt= t (keyword #f "truthy")))) (if (jolt-truthy? or__14__auto) or__14__auto (let* ((or__14__auto (jolt= t (keyword #f "phm")))) (if (jolt-truthy? or__14__auto) or__14__auto (let* ((or__14__auto (jolt-invoke (var-deref "jolt.passes.types.lattice" "struct-type?") t))) (if (jolt-truthy? or__14__auto) or__14__auto (let* ((or__14__auto (jolt-invoke (var-deref "jolt.passes.types.lattice" "vec-type?") t))) (if (jolt-truthy? or__14__auto) or__14__auto (jolt-invoke (var-deref "jolt.passes.types.lattice" "set-type?") t))))))))))))))))))) truthy-type?))) + (def-var! "jolt.passes.types.lattice" "truthy-type?" (letrec ((truthy-type? (lambda (t) (let fnrec3450 ((t t)) (let* ((or__14__auto (jolt= t (keyword #f "num")))) (if (jolt-truthy? or__14__auto) or__14__auto (let* ((or__14__auto (jolt= t (keyword #f "str")))) (if (jolt-truthy? or__14__auto) or__14__auto (let* ((or__14__auto (jolt= t (keyword #f "kw")))) (if (jolt-truthy? or__14__auto) or__14__auto (let* ((or__14__auto (jolt= t (keyword #f "truthy")))) (if (jolt-truthy? or__14__auto) or__14__auto (let* ((or__14__auto (jolt= t (keyword #f "phm")))) (if (jolt-truthy? or__14__auto) or__14__auto (let* ((or__14__auto (jolt-invoke (var-deref "jolt.passes.types.lattice" "struct-type?") t))) (if (jolt-truthy? or__14__auto) or__14__auto (let* ((or__14__auto (jolt-invoke (var-deref "jolt.passes.types.lattice" "vec-type?") t))) (if (jolt-truthy? or__14__auto) or__14__auto (jolt-invoke (var-deref "jolt.passes.types.lattice" "set-type?") t))))))))))))))))))) truthy-type?))) (guard (e (#t #f)) - (def-var! "jolt.passes.types.lattice" "num-ret-fns" (let* ((_o$2972 "+") (_o$2973 "-") (_o$2974 "*") (_o$2975 "/") (_o$2976 "inc") (_o$2977 "dec") (_o$2978 "mod") (_o$2979 "rem") (_o$2980 "quot") (_o$2981 "min") (_o$2982 "max") (_o$2983 "abs") (_o$2984 "bit-and") (_o$2985 "bit-or") (_o$2986 "bit-xor") (_o$2987 "count")) (jolt-hash-set _o$2972 _o$2973 _o$2974 _o$2975 _o$2976 _o$2977 _o$2978 _o$2979 _o$2980 _o$2981 _o$2982 _o$2983 _o$2984 _o$2985 _o$2986 _o$2987)))) + (def-var! "jolt.passes.types.lattice" "num-ret-fns" (let* ((_o$3451 "+") (_o$3452 "-") (_o$3453 "*") (_o$3454 "/") (_o$3455 "inc") (_o$3456 "dec") (_o$3457 "mod") (_o$3458 "rem") (_o$3459 "quot") (_o$3460 "min") (_o$3461 "max") (_o$3462 "abs") (_o$3463 "bit-and") (_o$3464 "bit-or") (_o$3465 "bit-xor") (_o$3466 "count")) (jolt-hash-set _o$3451 _o$3452 _o$3453 _o$3454 _o$3455 _o$3456 _o$3457 _o$3458 _o$3459 _o$3460 _o$3461 _o$3462 _o$3463 _o$3464 _o$3465 _o$3466)))) (guard (e (#t #f)) - (def-var! "jolt.passes.types.lattice" "vector-ret-fns" (let* ((_o$2988 "vec") (_o$2989 "vector") (_o$2990 "mapv") (_o$2991 "filterv") (_o$2992 "subvec")) (jolt-hash-set _o$2988 _o$2989 _o$2990 _o$2991 _o$2992)))) + (def-var! "jolt.passes.types.lattice" "vector-ret-fns" (let* ((_o$3467 "vec") (_o$3468 "vector") (_o$3469 "mapv") (_o$3470 "filterv") (_o$3471 "subvec")) (jolt-hash-set _o$3467 _o$3468 _o$3469 _o$3470 _o$3471)))) (guard (e (#t #f)) - (def-var-with-meta! "jolt.passes.types" "config-box" (jolt-invoke (var-deref "clojure.core" "atom") (let* ((_o$2993 (keyword #f "rtenv")) (_o$2994 (jolt-hash-map)) (_o$2995 (keyword #f "vtypes")) (_o$2996 (jolt-hash-map)) (_o$2997 (keyword #f "record-shapes")) (_o$2998 (jolt-hash-map)) (_o$2999 (keyword #f "protocol-methods")) (_o$3000 (jolt-hash-map)) (_o$3001 (keyword #f "map-shapes?")) (_o$3002 #f)) (jolt-hash-map _o$2993 _o$2994 _o$2995 _o$2996 _o$2997 _o$2998 _o$2999 _o$3000 _o$3001 _o$3002))) (jolt-hash-map (keyword #f "private") #t))) + (def-var! "jolt.passes.types.check" "not-number?" (letrec ((not-number? (lambda (t) (let fnrec3472 ((t t)) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.passes.types.lattice" "union-type?") t)) (jolt-invoke (var-deref "clojure.core" "every?") not-number? (jolt-invoke (var-deref "jolt.passes.types.lattice" "umembers") t)) (let* ((or__14__auto (jolt= t (keyword #f "str")))) (if (jolt-truthy? or__14__auto) or__14__auto (let* ((or__14__auto (jolt= t (keyword #f "kw")))) (if (jolt-truthy? or__14__auto) or__14__auto (let* ((or__14__auto (jolt= t (keyword #f "phm")))) (if (jolt-truthy? or__14__auto) or__14__auto (let* ((or__14__auto (jolt-invoke (var-deref "jolt.passes.types.lattice" "struct-type?") t))) (if (jolt-truthy? or__14__auto) or__14__auto (let* ((or__14__auto (jolt-invoke (var-deref "jolt.passes.types.lattice" "vec-type?") t))) (if (jolt-truthy? or__14__auto) or__14__auto (jolt-invoke (var-deref "jolt.passes.types.lattice" "set-type?") t)))))))))))))))) not-number?))) +(guard (e (#t #f)) + (def-var! "jolt.passes.types.check" "not-seqable?" (letrec ((not-seqable? (lambda (t) (let fnrec3473 ((t t)) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.passes.types.lattice" "union-type?") t)) (jolt-invoke (var-deref "clojure.core" "every?") not-seqable? (jolt-invoke (var-deref "jolt.passes.types.lattice" "umembers") t)) (let* ((or__14__auto (jolt= t (keyword #f "num")))) (if (jolt-truthy? or__14__auto) or__14__auto (jolt= t (keyword #f "kw"))))))))) not-seqable?))) +(guard (e (#t #f)) + (def-var! "jolt.passes.types.check" "not-callable?" (letrec ((not-callable? (lambda (t) (let fnrec3474 ((t t)) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.passes.types.lattice" "union-type?") t)) (jolt-invoke (var-deref "clojure.core" "every?") not-callable? (jolt-invoke (var-deref "jolt.passes.types.lattice" "umembers") t)) (let* ((or__14__auto (jolt= t (keyword #f "num")))) (if (jolt-truthy? or__14__auto) or__14__auto (jolt= t (keyword #f "str"))))))))) not-callable?))) +(guard (e (#t #f)) + (def-var-with-meta! "jolt.passes.types.check" "num-ops" (let* ((_o$3475 "+") (_o$3476 "-") (_o$3477 "*") (_o$3478 "/") (_o$3479 "inc") (_o$3480 "dec") (_o$3481 "mod") (_o$3482 "rem") (_o$3483 "quot") (_o$3484 "min") (_o$3485 "max") (_o$3486 "abs") (_o$3487 "bit-and") (_o$3488 "bit-or") (_o$3489 "bit-xor") (_o$3490 "bit-not") (_o$3491 "bit-shift-left") (_o$3492 "bit-shift-right")) (jolt-hash-set _o$3475 _o$3476 _o$3477 _o$3478 _o$3479 _o$3480 _o$3481 _o$3482 _o$3483 _o$3484 _o$3485 _o$3486 _o$3487 _o$3488 _o$3489 _o$3490 _o$3491 _o$3492)) (jolt-hash-map (keyword #f "private") #t))) +(guard (e (#t #f)) + (def-var-with-meta! "jolt.passes.types.check" "seq-ops" (let* ((_o$3493 "count") (_o$3494 "first") (_o$3495 "rest") (_o$3496 "next") (_o$3497 "seq") (_o$3498 "nth")) (jolt-hash-set _o$3493 _o$3494 _o$3495 _o$3496 _o$3497 _o$3498)) (jolt-hash-map (keyword #f "private") #t))) +(guard (e (#t #f)) + (def-var! "jolt.passes.types.check" "type-name" (letrec ((type-name (lambda (t) (let fnrec3499 ((t t)) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.passes.types.lattice" "union-type?") t)) (let* ((_a$3501 (lambda (s m) (let fnrec3500 ((s s) (m m)) (if (jolt= s "") (jolt-invoke type-name m) (jolt-invoke (var-deref "clojure.core" "str") s " or " (jolt-invoke type-name m)))))) (_a$3502 "") (_a$3503 (jolt-invoke (var-deref "jolt.passes.types.lattice" "umembers") t))) (jolt-reduce _a$3501 _a$3502 _a$3503)) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.passes.types.lattice" "struct-type?") t)) "a map" (if (jolt-truthy? (jolt-invoke (var-deref "jolt.passes.types.lattice" "vec-type?") t)) "a vector" (if (jolt-truthy? (jolt-invoke (var-deref "jolt.passes.types.lattice" "set-type?") t)) "a set" (if (jolt= t (keyword #f "str")) "a string" (if (jolt= t (keyword #f "kw")) "a keyword" (if (jolt= t (keyword #f "num")) "a number" (if (jolt= t (keyword #f "phm")) "a map" (if (jolt-truthy? (keyword #f "else")) (jolt-invoke (var-deref "clojure.core" "str") t) jolt-nil))))))))))))) type-name))) +(guard (e (#t #f)) + (def-var! "jolt.passes.types.check" "check-invoke" (letrec ((check-invoke (lambda (cn args arg-types pos env) (let fnrec3504 ((cn cn) (args args) (arg-types arg-types) (pos pos) (env env)) (if (jolt-contains? (var-deref "jolt.passes.types.check" "num-ops") cn) (let* ((_a$3527 (lambda (_ i) (let fnrec3505 ((_ _) (i i)) (begin (let* ((t (jolt-nth arg-types i))) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.passes.types.check" "not-number?") t)) (let* ((_a$3523 (var-deref "clojure.core" "swap!")) (_a$3524 (jolt-get env (keyword #f "diags"))) (_a$3525 jolt-conj) (_a$3526 (let* ((_o$3513 (keyword #f "op")) (_o$3514 cn) (_o$3515 (keyword #f "argpos")) (_o$3516 i) (_o$3517 (keyword #f "type")) (_o$3518 (jolt-invoke (var-deref "jolt.passes.types.check" "type-name") t)) (_o$3519 (keyword #f "pos")) (_o$3520 pos) (_o$3521 (keyword #f "msg")) (_o$3522 (let* ((_a$3506 (var-deref "clojure.core" "str")) (_a$3507 "`") (_a$3508 cn) (_a$3509 "` requires a number, but argument ") (_a$3510 (jolt-inc i)) (_a$3511 " is ") (_a$3512 (jolt-invoke (var-deref "jolt.passes.types.check" "type-name") t))) (jolt-invoke _a$3506 _a$3507 _a$3508 _a$3509 _a$3510 _a$3511 _a$3512)))) (jolt-hash-map _o$3513 _o$3514 _o$3515 _o$3516 _o$3517 _o$3518 _o$3519 _o$3520 _o$3521 _o$3522)))) (jolt-invoke _a$3523 _a$3524 _a$3525 _a$3526)) jolt-nil)) jolt-nil)))) (_a$3528 jolt-nil) (_a$3529 (jolt-range (jolt-count args)))) (jolt-reduce _a$3527 _a$3528 _a$3529)) (if (jolt-truthy? (let* ((and__13__auto (jolt-contains? (var-deref "jolt.passes.types.check" "seq-ops") cn))) (if (jolt-truthy? and__13__auto) (> (jolt-count args) 0) and__13__auto))) (let* ((t (jolt-nth arg-types 0))) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.passes.types.check" "not-seqable?") t)) (let* ((_a$3547 (var-deref "clojure.core" "swap!")) (_a$3548 (jolt-get env (keyword #f "diags"))) (_a$3549 jolt-conj) (_a$3550 (let* ((_o$3537 (keyword #f "op")) (_o$3538 cn) (_o$3539 (keyword #f "argpos")) (_o$3540 0) (_o$3541 (keyword #f "type")) (_o$3542 (jolt-invoke (var-deref "jolt.passes.types.check" "type-name") t)) (_o$3543 (keyword #f "pos")) (_o$3544 pos) (_o$3545 (keyword #f "msg")) (_o$3546 (let* ((_a$3530 (var-deref "clojure.core" "str")) (_a$3531 "`") (_a$3532 cn) (_a$3533 "` requires ") (_a$3534 (if (jolt= cn "count") "a countable collection" "a seqable")) (_a$3535 ", but argument 1 is ") (_a$3536 (jolt-invoke (var-deref "jolt.passes.types.check" "type-name") t))) (jolt-invoke _a$3530 _a$3531 _a$3532 _a$3533 _a$3534 _a$3535 _a$3536)))) (jolt-hash-map _o$3537 _o$3538 _o$3539 _o$3540 _o$3541 _o$3542 _o$3543 _o$3544 _o$3545 _o$3546)))) (jolt-invoke _a$3547 _a$3548 _a$3549 _a$3550)) jolt-nil)) (if (jolt-truthy? (keyword #f "else")) jolt-nil jolt-nil))))))) check-invoke))) +(guard (e (#t #f)) + (def-var! "jolt.passes.types.check" "register-user-fn!" (letrec ((register-user-fn! (lambda (node env) (let fnrec3551 ((node node) (env env)) (let* ((init (jolt-get node (keyword #f "init"))) (m (jolt-get node (keyword #f "meta"))) (redefable (let* ((and__13__auto m)) (if (jolt-truthy? and__13__auto) (let* ((or__14__auto (jolt-get m (keyword #f "redef")))) (if (jolt-truthy? or__14__auto) or__14__auto (jolt-get m (keyword #f "dynamic")))) and__13__auto)))) (if (jolt-truthy? (let* ((and__13__auto (jolt-not redefable))) (if (jolt-truthy? and__13__auto) (jolt= (keyword #f "fn") (jolt-get init (keyword #f "op"))) and__13__auto))) (let* ((arities (jolt-get init (keyword #f "arities")))) (if (jolt= 1 (jolt-count arities)) (let* ((ar (jolt-first arities))) (if (jolt-not (jolt-get ar (keyword #f "rest"))) (let* ((_a$3562 (var-deref "clojure.core" "swap!")) (_a$3563 (jolt-get env (keyword #f "user-sigs"))) (_a$3564 jolt-assoc) (_a$3565 (let* ((_a$3552 (var-deref "clojure.core" "str")) (_a$3553 (jolt-get node (keyword #f "ns"))) (_a$3554 "/") (_a$3555 (jolt-get node (keyword #f "name")))) (jolt-invoke _a$3552 _a$3553 _a$3554 _a$3555))) (_a$3566 (let* ((_o$3556 (keyword #f "name")) (_o$3557 (jolt-get node (keyword #f "name"))) (_o$3558 (keyword #f "params")) (_o$3559 (jolt-get ar (keyword #f "params"))) (_o$3560 (keyword #f "body")) (_o$3561 (jolt-get ar (keyword #f "body")))) (jolt-hash-map _o$3556 _o$3557 _o$3558 _o$3559 _o$3560 _o$3561)))) (jolt-invoke _a$3562 _a$3563 _a$3564 _a$3565 _a$3566)) jolt-nil)) jolt-nil)) jolt-nil)))))) register-user-fn!))) +(guard (e (#t #f)) + (def-var-with-meta! "jolt.passes.types" "config-box" (jolt-invoke (var-deref "clojure.core" "atom") (let* ((_o$2878 (keyword #f "rtenv")) (_o$2879 (jolt-hash-map)) (_o$2880 (keyword #f "vtypes")) (_o$2881 (jolt-hash-map)) (_o$2882 (keyword #f "record-shapes")) (_o$2883 (jolt-hash-map)) (_o$2884 (keyword #f "protocol-methods")) (_o$2885 (jolt-hash-map)) (_o$2886 (keyword #f "map-shapes?")) (_o$2887 #f)) (jolt-hash-map _o$2878 _o$2879 _o$2880 _o$2881 _o$2882 _o$2883 _o$2884 _o$2885 _o$2886 _o$2887))) (jolt-hash-map (keyword #f "private") #t))) (guard (e (#t #f)) (def-var-with-meta! "jolt.passes.types" "escapes-box" (jolt-invoke (var-deref "clojure.core" "atom") (jolt-hash-set)) (jolt-hash-map (keyword #f "private") #t))) (guard (e (#t #f)) @@ -423,118 +439,102 @@ (guard (e (#t #f)) (def-var-with-meta! "jolt.passes.types" "last-diags-box" (jolt-invoke (var-deref "clojure.core" "atom") (jolt-vector)) (jolt-hash-map (keyword #f "private") #t))) (guard (e (#t #f)) - (def-var-with-meta! "jolt.passes.types" "check-mode-box" (jolt-invoke (var-deref "clojure.core" "atom") (let* ((_o$3003 (keyword #f "on")) (_o$3004 #f) (_o$3005 (keyword #f "strict")) (_o$3006 #f)) (jolt-hash-map _o$3003 _o$3004 _o$3005 _o$3006))) (jolt-hash-map (keyword #f "private") #t))) + (def-var-with-meta! "jolt.passes.types" "check-mode-box" (jolt-invoke (var-deref "clojure.core" "atom") (let* ((_o$2888 (keyword #f "on")) (_o$2889 #f) (_o$2890 (keyword #f "strict")) (_o$2891 #f)) (jolt-hash-map _o$2888 _o$2889 _o$2890 _o$2891))) (jolt-hash-map (keyword #f "private") #t))) (guard (e (#t #f)) - (def-var! "jolt.passes.types" "mk-env" (letrec ((mk-env (lambda (checking? strict?) (let fnrec3007 ((checking? checking?) (strict? strict?)) (let* ((c (jolt-invoke (var-deref "clojure.core" "deref") (var-deref "jolt.passes.types" "config-box")))) (let* ((_o$3008 (keyword #f "rtenv")) (_o$3009 (jolt-get c (keyword #f "rtenv"))) (_o$3010 (keyword #f "vtypes")) (_o$3011 (jolt-get c (keyword #f "vtypes"))) (_o$3012 (keyword #f "record-shapes")) (_o$3013 (jolt-get c (keyword #f "record-shapes"))) (_o$3014 (keyword #f "protocol-methods")) (_o$3015 (jolt-get c (keyword #f "protocol-methods"))) (_o$3016 (keyword #f "map-shapes?")) (_o$3017 (jolt-get c (keyword #f "map-shapes?"))) (_o$3018 (keyword #f "checking?")) (_o$3019 checking?) (_o$3020 (keyword #f "strict?")) (_o$3021 strict?) (_o$3022 (keyword #f "diags")) (_o$3023 (jolt-invoke (var-deref "clojure.core" "atom") (jolt-vector))) (_o$3024 (keyword #f "calls")) (_o$3025 (jolt-invoke (var-deref "clojure.core" "atom") (jolt-vector))) (_o$3026 (keyword #f "checking-set")) (_o$3027 (jolt-invoke (var-deref "clojure.core" "atom") (jolt-hash-set))) (_o$3028 (keyword #f "diag-memo")) (_o$3029 (jolt-invoke (var-deref "clojure.core" "atom") (jolt-hash-map))) (_o$3030 (keyword #f "escapes")) (_o$3031 (var-deref "jolt.passes.types" "escapes-box")) (_o$3032 (keyword #f "user-sigs")) (_o$3033 (var-deref "jolt.passes.types" "user-sig-box"))) (jolt-hash-map _o$3008 _o$3009 _o$3010 _o$3011 _o$3012 _o$3013 _o$3014 _o$3015 _o$3016 _o$3017 _o$3018 _o$3019 _o$3020 _o$3021 _o$3022 _o$3023 _o$3024 _o$3025 _o$3026 _o$3027 _o$3028 _o$3029 _o$3030 _o$3031 _o$3032 _o$3033))))))) mk-env))) + (def-var! "jolt.passes.types" "mk-env" (letrec ((mk-env (lambda (checking? strict?) (let fnrec2892 ((checking? checking?) (strict? strict?)) (let* ((c (jolt-invoke (var-deref "clojure.core" "deref") (var-deref "jolt.passes.types" "config-box")))) (let* ((_o$2893 (keyword #f "rtenv")) (_o$2894 (jolt-get c (keyword #f "rtenv"))) (_o$2895 (keyword #f "vtypes")) (_o$2896 (jolt-get c (keyword #f "vtypes"))) (_o$2897 (keyword #f "record-shapes")) (_o$2898 (jolt-get c (keyword #f "record-shapes"))) (_o$2899 (keyword #f "protocol-methods")) (_o$2900 (jolt-get c (keyword #f "protocol-methods"))) (_o$2901 (keyword #f "map-shapes?")) (_o$2902 (jolt-get c (keyword #f "map-shapes?"))) (_o$2903 (keyword #f "checking?")) (_o$2904 checking?) (_o$2905 (keyword #f "strict?")) (_o$2906 strict?) (_o$2907 (keyword #f "diags")) (_o$2908 (jolt-invoke (var-deref "clojure.core" "atom") (jolt-vector))) (_o$2909 (keyword #f "calls")) (_o$2910 (jolt-invoke (var-deref "clojure.core" "atom") (jolt-vector))) (_o$2911 (keyword #f "checking-set")) (_o$2912 (jolt-invoke (var-deref "clojure.core" "atom") (jolt-hash-set))) (_o$2913 (keyword #f "diag-memo")) (_o$2914 (jolt-invoke (var-deref "clojure.core" "atom") (jolt-hash-map))) (_o$2915 (keyword #f "escapes")) (_o$2916 (var-deref "jolt.passes.types" "escapes-box")) (_o$2917 (keyword #f "user-sigs")) (_o$2918 (var-deref "jolt.passes.types" "user-sig-box"))) (jolt-hash-map _o$2893 _o$2894 _o$2895 _o$2896 _o$2897 _o$2898 _o$2899 _o$2900 _o$2901 _o$2902 _o$2903 _o$2904 _o$2905 _o$2906 _o$2907 _o$2908 _o$2909 _o$2910 _o$2911 _o$2912 _o$2913 _o$2914 _o$2915 _o$2916 _o$2917 _o$2918))))))) mk-env))) (guard (e (#t #f)) (declare-var! "jolt.passes.types" "record-type-from-entry")) (guard (e (#t #f)) - (def-var! "jolt.passes.types" "field-type-from-tag" (letrec ((field-type-from-tag (lambda (tag depth shapes) (let fnrec3034 ((tag tag) (depth depth) (shapes shapes)) (if (jolt-truthy? (let* ((or__14__auto (jolt-invoke (var-deref "clojure.core" "nil?") tag))) (if (jolt-truthy? or__14__auto) or__14__auto (<= depth 0)))) (keyword #f "any") (if (jolt= tag "num") (keyword #f "num") (if (jolt-truthy? (keyword #f "else")) (let* ((e (jolt-get shapes tag))) (if (jolt-truthy? e) (jolt-invoke (var-deref "jolt.passes.types" "record-type-from-entry") e depth shapes) (keyword #f "any"))) jolt-nil))))))) field-type-from-tag))) + (def-var! "jolt.passes.types" "field-type-from-tag" (letrec ((field-type-from-tag (lambda (tag depth shapes) (let fnrec2919 ((tag tag) (depth depth) (shapes shapes)) (if (jolt-truthy? (let* ((or__14__auto (jolt-invoke (var-deref "clojure.core" "nil?") tag))) (if (jolt-truthy? or__14__auto) or__14__auto (<= depth 0)))) (keyword #f "any") (if (jolt= tag "num") (keyword #f "num") (if (jolt-truthy? (keyword #f "else")) (let* ((e (jolt-get shapes tag))) (if (jolt-truthy? e) (jolt-invoke (var-deref "jolt.passes.types" "record-type-from-entry") e depth shapes) (keyword #f "any"))) jolt-nil))))))) field-type-from-tag))) (guard (e (#t #f)) - (def-var! "jolt.passes.types" "record-type-from-entry" (letrec ((record-type-from-entry (lambda (rs depth shapes) (let fnrec3035 ((rs rs) (depth depth) (shapes shapes)) (let* ((fields (jolt-get rs (keyword #f "fields"))) (tags (jolt-get rs (keyword #f "tags"))) (fmap (let* ((_a$3044 (lambda (m i) (let fnrec3036 ((m m) (i i)) (let* ((_a$3041 m) (_a$3042 (jolt-nth fields i)) (_a$3043 (let* ((_a$3037 (var-deref "jolt.passes.types" "field-type-from-tag")) (_a$3038 (if (jolt-truthy? tags) (jolt-nth tags i) jolt-nil)) (_a$3039 (jolt-dec depth)) (_a$3040 shapes)) (jolt-invoke _a$3037 _a$3038 _a$3039 _a$3040)))) (jolt-assoc _a$3041 _a$3042 _a$3043))))) (_a$3045 (jolt-hash-map)) (_a$3046 (jolt-range (jolt-count fields)))) (jolt-reduce _a$3044 _a$3045 _a$3046)))) (let* ((_a$3047 (jolt-invoke (var-deref "jolt.passes.types.lattice" "mk-struct") fmap)) (_a$3048 (keyword #f "shape")) (_a$3049 (jolt-invoke (var-deref "clojure.core" "vec") fields)) (_a$3050 (keyword #f "type")) (_a$3051 (jolt-get rs (keyword #f "type")))) (jolt-assoc _a$3047 _a$3048 _a$3049 _a$3050 _a$3051))))))) record-type-from-entry))) + (def-var! "jolt.passes.types" "record-type-from-entry" (letrec ((record-type-from-entry (lambda (rs depth shapes) (let fnrec2920 ((rs rs) (depth depth) (shapes shapes)) (let* ((fields (jolt-get rs (keyword #f "fields"))) (tags (jolt-get rs (keyword #f "tags"))) (fmap (let* ((_a$2929 (lambda (m i) (let fnrec2921 ((m m) (i i)) (let* ((_a$2926 m) (_a$2927 (jolt-nth fields i)) (_a$2928 (let* ((_a$2922 (var-deref "jolt.passes.types" "field-type-from-tag")) (_a$2923 (if (jolt-truthy? tags) (jolt-nth tags i) jolt-nil)) (_a$2924 (jolt-dec depth)) (_a$2925 shapes)) (jolt-invoke _a$2922 _a$2923 _a$2924 _a$2925)))) (jolt-assoc _a$2926 _a$2927 _a$2928))))) (_a$2930 (jolt-hash-map)) (_a$2931 (jolt-range (jolt-count fields)))) (jolt-reduce _a$2929 _a$2930 _a$2931)))) (let* ((_a$2932 (jolt-invoke (var-deref "jolt.passes.types.lattice" "mk-struct") fmap)) (_a$2933 (keyword #f "shape")) (_a$2934 (jolt-invoke (var-deref "clojure.core" "vec") fields)) (_a$2935 (keyword #f "type")) (_a$2936 (jolt-get rs (keyword #f "type")))) (jolt-assoc _a$2932 _a$2933 _a$2934 _a$2935 _a$2936))))))) record-type-from-entry))) (guard (e (#t #f)) - (def-var-with-meta! "jolt.passes.types" "elem-fns" (let* ((_o$3052 "rand-nth") (_o$3053 "first") (_o$3054 "peek") (_o$3055 "last") (_o$3056 "nth") (_o$3057 "fnext") (_o$3058 "second")) (jolt-hash-set _o$3052 _o$3053 _o$3054 _o$3055 _o$3056 _o$3057 _o$3058)) (jolt-hash-map (keyword #f "private") #t))) + (def-var-with-meta! "jolt.passes.types" "elem-fns" (let* ((_o$2937 "rand-nth") (_o$2938 "first") (_o$2939 "peek") (_o$2940 "last") (_o$2941 "nth") (_o$2942 "fnext") (_o$2943 "second")) (jolt-hash-set _o$2937 _o$2938 _o$2939 _o$2940 _o$2941 _o$2942 _o$2943)) (jolt-hash-map (keyword #f "private") #t))) (guard (e (#t #f)) - (begin (declare-var! "jolt.passes.types" "check-invoke") (declare-var! "jolt.passes.types" "check-user-call") (declare-var! "jolt.passes.types" "register-user-fn!") (declare-var! "jolt.passes.types" "not-callable?") (declare-var! "jolt.passes.types" "type-name"))) + (declare-var! "jolt.passes.types" "check-user-call")) (guard (e (#t #f)) - (def-var! "jolt.passes.types" "var-key" (letrec ((var-key (lambda (fnode) (let fnrec3059 ((fnode fnode)) (let* ((_a$3060 (var-deref "clojure.core" "str")) (_a$3061 (jolt-get fnode (keyword #f "ns"))) (_a$3062 "/") (_a$3063 (jolt-get fnode (keyword #f "name")))) (jolt-invoke _a$3060 _a$3061 _a$3062 _a$3063)))))) var-key))) + (def-var! "jolt.passes.types" "var-key" (letrec ((var-key (lambda (fnode) (let fnrec2944 ((fnode fnode)) (let* ((_a$2945 (var-deref "clojure.core" "str")) (_a$2946 (jolt-get fnode (keyword #f "ns"))) (_a$2947 "/") (_a$2948 (jolt-get fnode (keyword #f "name")))) (jolt-invoke _a$2945 _a$2946 _a$2947 _a$2948)))))) var-key))) (guard (e (#t #f)) - (def-var! "jolt.passes.types" "call-ret-type" (letrec ((call-ret-type (lambda (fnode env) (let fnrec3064 ((fnode fnode) (env env)) (let* ((op (jolt-get fnode (keyword #f "op"))) (shapes (jolt-get env (keyword #f "record-shapes")))) (if (jolt= op (keyword #f "var")) (let* ((rs (jolt-get shapes (jolt-invoke (var-deref "jolt.passes.types" "var-key") fnode)))) (if (jolt-truthy? rs) (jolt-invoke (var-deref "jolt.passes.types" "record-type-from-entry") rs (var-deref "jolt.passes.types.lattice" "type-depth") shapes) (let* ((r (let* ((_a$3065 (jolt-get env (keyword #f "rtenv"))) (_a$3066 (jolt-invoke (var-deref "jolt.passes.types" "var-key") fnode))) (jolt-get _a$3065 _a$3066)))) (if (jolt-truthy? r) r (let* ((nm (let* ((and__13__auto (jolt= "clojure.core" (jolt-get fnode (keyword #f "ns"))))) (if (jolt-truthy? and__13__auto) (jolt-get fnode (keyword #f "name")) and__13__auto)))) (if (jolt-truthy? (jolt-invoke (var-deref "clojure.core" "nil?") nm)) (keyword #f "any") (if (jolt-contains? (var-deref "jolt.passes.types.lattice" "num-ret-fns") nm) (keyword #f "num") (if (jolt-contains? (var-deref "jolt.passes.types.lattice" "vector-ret-fns") nm) (jolt-invoke (var-deref "jolt.passes.types.lattice" "mk-vec") (keyword #f "any")) (if (jolt-truthy? (keyword #f "else")) (keyword #f "any") jolt-nil))))))))) (if (jolt= op (keyword #f "host")) (let* ((nm (jolt-get fnode (keyword #f "name")))) (if (jolt-contains? (var-deref "jolt.passes.types.lattice" "num-ret-fns") nm) (keyword #f "num") (if (jolt-contains? (var-deref "jolt.passes.types.lattice" "vector-ret-fns") nm) (jolt-invoke (var-deref "jolt.passes.types.lattice" "mk-vec") (keyword #f "any")) (if (jolt-truthy? (keyword #f "else")) (keyword #f "any") jolt-nil)))) (if (jolt-truthy? (keyword #f "else")) (keyword #f "any") jolt-nil)))))))) call-ret-type))) + (def-var! "jolt.passes.types" "call-ret-type" (letrec ((call-ret-type (lambda (fnode env) (let fnrec2949 ((fnode fnode) (env env)) (let* ((op (jolt-get fnode (keyword #f "op"))) (shapes (jolt-get env (keyword #f "record-shapes")))) (if (jolt= op (keyword #f "var")) (let* ((rs (jolt-get shapes (jolt-invoke (var-deref "jolt.passes.types" "var-key") fnode)))) (if (jolt-truthy? rs) (jolt-invoke (var-deref "jolt.passes.types" "record-type-from-entry") rs (var-deref "jolt.passes.types.lattice" "type-depth") shapes) (let* ((r (let* ((_a$2950 (jolt-get env (keyword #f "rtenv"))) (_a$2951 (jolt-invoke (var-deref "jolt.passes.types" "var-key") fnode))) (jolt-get _a$2950 _a$2951)))) (if (jolt-truthy? r) r (let* ((nm (let* ((and__13__auto (jolt= "clojure.core" (jolt-get fnode (keyword #f "ns"))))) (if (jolt-truthy? and__13__auto) (jolt-get fnode (keyword #f "name")) and__13__auto)))) (if (jolt-truthy? (jolt-invoke (var-deref "clojure.core" "nil?") nm)) (keyword #f "any") (if (jolt-contains? (var-deref "jolt.passes.types.lattice" "num-ret-fns") nm) (keyword #f "num") (if (jolt-contains? (var-deref "jolt.passes.types.lattice" "vector-ret-fns") nm) (jolt-invoke (var-deref "jolt.passes.types.lattice" "mk-vec") (keyword #f "any")) (if (jolt-truthy? (keyword #f "else")) (keyword #f "any") jolt-nil))))))))) (if (jolt= op (keyword #f "host")) (let* ((nm (jolt-get fnode (keyword #f "name")))) (if (jolt-contains? (var-deref "jolt.passes.types.lattice" "num-ret-fns") nm) (keyword #f "num") (if (jolt-contains? (var-deref "jolt.passes.types.lattice" "vector-ret-fns") nm) (jolt-invoke (var-deref "jolt.passes.types.lattice" "mk-vec") (keyword #f "any")) (if (jolt-truthy? (keyword #f "else")) (keyword #f "any") jolt-nil)))) (if (jolt-truthy? (keyword #f "else")) (keyword #f "any") jolt-nil)))))))) call-ret-type))) (guard (e (#t #f)) - (def-var-with-meta! "jolt.passes.types" "fold-preds" (let* ((_o$3067 "number?") (_o$3068 "string?") (_o$3069 "keyword?") (_o$3070 "record?") (_o$3071 "nil?") (_o$3072 "some?")) (jolt-hash-set _o$3067 _o$3068 _o$3069 _o$3070 _o$3071 _o$3072)) (jolt-hash-map (keyword #f "private") #t))) + (def-var-with-meta! "jolt.passes.types" "fold-preds" (let* ((_o$2952 "number?") (_o$2953 "string?") (_o$2954 "keyword?") (_o$2955 "record?") (_o$2956 "nil?") (_o$2957 "some?")) (jolt-hash-set _o$2952 _o$2953 _o$2954 _o$2955 _o$2956 _o$2957)) (jolt-hash-map (keyword #f "private") #t))) (guard (e (#t #f)) - (def-var! "jolt.passes.types" "record-t?" (letrec ((record-t? (lambda (t) (let fnrec3073 ((t t)) (let* ((and__13__auto (jolt-invoke (var-deref "jolt.passes.types.lattice" "struct-type?") t))) (if (jolt-truthy? and__13__auto) (jolt-invoke (var-deref "clojure.core" "some?") (jolt-get t (keyword #f "type"))) and__13__auto)))))) record-t?))) + (def-var! "jolt.passes.types" "record-t?" (letrec ((record-t? (lambda (t) (let fnrec2958 ((t t)) (let* ((and__13__auto (jolt-invoke (var-deref "jolt.passes.types.lattice" "struct-type?") t))) (if (jolt-truthy? and__13__auto) (jolt-invoke (var-deref "clojure.core" "some?") (jolt-get t (keyword #f "type"))) and__13__auto)))))) record-t?))) (guard (e (#t #f)) - (def-var! "jolt.passes.types" "pred-on" (letrec ((pred-on (lambda (pname t) (let fnrec3074 ((pname pname) (t t)) (if (jolt-truthy? (let* ((or__14__auto (jolt= t (keyword #f "any")))) (if (jolt-truthy? or__14__auto) or__14__auto (jolt= t (keyword #f "truthy"))))) jolt-nil (if (jolt-truthy? (jolt-invoke (var-deref "jolt.passes.types.lattice" "union-type?") t)) (let* ((vs (let* ((_a$3076 (lambda (m) (let fnrec3075 ((m m)) (jolt-invoke pred-on pname m)))) (_a$3077 (jolt-invoke (var-deref "jolt.passes.types.lattice" "umembers") t))) (jolt-map _a$3076 _a$3077)))) (if (jolt-truthy? (let* ((and__13__auto (jolt-seq vs))) (if (jolt-truthy? and__13__auto) (let* ((and__13__auto (jolt-not (jolt-invoke (var-deref "clojure.core" "nil?") (jolt-first vs))))) (if (jolt-truthy? and__13__auto) (jolt-apply jolt= vs) and__13__auto)) and__13__auto))) (jolt-first vs) jolt-nil)) (if (jolt-truthy? (keyword #f "else")) (let* ((G__33 pname)) (if (jolt= G__33 "number?") (jolt= t (keyword #f "num")) (if (jolt= G__33 "string?") (jolt= t (keyword #f "str")) (if (jolt= G__33 "keyword?") (jolt= t (keyword #f "kw")) (if (jolt= G__33 "record?") (jolt-invoke (var-deref "jolt.passes.types" "record-t?") t) (if (jolt= G__33 "nil?") #f (if (jolt= G__33 "some?") #t jolt-nil))))))) jolt-nil))))))) pred-on))) + (def-var! "jolt.passes.types" "pred-on" (letrec ((pred-on (lambda (pname t) (let fnrec2959 ((pname pname) (t t)) (if (jolt-truthy? (let* ((or__14__auto (jolt= t (keyword #f "any")))) (if (jolt-truthy? or__14__auto) or__14__auto (jolt= t (keyword #f "truthy"))))) jolt-nil (if (jolt-truthy? (jolt-invoke (var-deref "jolt.passes.types.lattice" "union-type?") t)) (let* ((vs (let* ((_a$2961 (lambda (m) (let fnrec2960 ((m m)) (jolt-invoke pred-on pname m)))) (_a$2962 (jolt-invoke (var-deref "jolt.passes.types.lattice" "umembers") t))) (jolt-map _a$2961 _a$2962)))) (if (jolt-truthy? (let* ((and__13__auto (jolt-seq vs))) (if (jolt-truthy? and__13__auto) (let* ((and__13__auto (jolt-not (jolt-invoke (var-deref "clojure.core" "nil?") (jolt-first vs))))) (if (jolt-truthy? and__13__auto) (jolt-apply jolt= vs) and__13__auto)) and__13__auto))) (jolt-first vs) jolt-nil)) (if (jolt-truthy? (keyword #f "else")) (let* ((G__33 pname)) (if (jolt= G__33 "number?") (jolt= t (keyword #f "num")) (if (jolt= G__33 "string?") (jolt= t (keyword #f "str")) (if (jolt= G__33 "keyword?") (jolt= t (keyword #f "kw")) (if (jolt= G__33 "record?") (jolt-invoke (var-deref "jolt.passes.types" "record-t?") t) (if (jolt= G__33 "nil?") #f (if (jolt= G__33 "some?") #t jolt-nil))))))) jolt-nil))))))) pred-on))) (guard (e (#t #f)) - (def-var! "jolt.passes.types" "pure-node?" (letrec ((pure-node? (lambda (n) (let fnrec3078 ((n n)) (let* ((op (jolt-get n (keyword #f "op")))) (let* ((or__14__auto (jolt= op (keyword #f "const")))) (if (jolt-truthy? or__14__auto) or__14__auto (jolt= op (keyword #f "local"))))))))) pure-node?))) + (def-var! "jolt.passes.types" "pure-node?" (letrec ((pure-node? (lambda (n) (let fnrec2963 ((n n)) (let* ((op (jolt-get n (keyword #f "op")))) (let* ((or__14__auto (jolt= op (keyword #f "const")))) (if (jolt-truthy? or__14__auto) or__14__auto (jolt= op (keyword #f "local"))))))))) pure-node?))) (guard (e (#t #f)) (declare-var! "jolt.passes.types" "infer")) (guard (e (#t #f)) - (def-var! "jolt.passes.types" "ty" (letrec ((ty (lambda (r) (let fnrec3079 ((r r)) (jolt-nth r 0))))) ty))) + (def-var! "jolt.passes.types" "ty" (letrec ((ty (lambda (r) (let fnrec2964 ((r r)) (jolt-nth r 0))))) ty))) (guard (e (#t #f)) - (def-var! "jolt.passes.types" "nd" (letrec ((nd (lambda (r) (let fnrec3080 ((r r)) (jolt-nth r 1))))) nd))) + (def-var! "jolt.passes.types" "nd" (letrec ((nd (lambda (r) (let fnrec2965 ((r r)) (jolt-nth r 1))))) nd))) (guard (e (#t #f)) - (def-var-with-meta! "jolt.passes.types" "hof-table" (let* ((_o$3097 "map") (_o$3098 (let* ((_o$3081 (keyword #f "epos")) (_o$3082 0)) (jolt-hash-map _o$3081 _o$3082))) (_o$3099 "mapv") (_o$3100 (let* ((_o$3083 (keyword #f "epos")) (_o$3084 0)) (jolt-hash-map _o$3083 _o$3084))) (_o$3101 "filter") (_o$3102 (let* ((_o$3085 (keyword #f "epos")) (_o$3086 0)) (jolt-hash-map _o$3085 _o$3086))) (_o$3103 "filterv") (_o$3104 (let* ((_o$3087 (keyword #f "epos")) (_o$3088 0)) (jolt-hash-map _o$3087 _o$3088))) (_o$3105 "keep") (_o$3106 (let* ((_o$3089 (keyword #f "epos")) (_o$3090 0)) (jolt-hash-map _o$3089 _o$3090))) (_o$3107 "remove") (_o$3108 (let* ((_o$3091 (keyword #f "epos")) (_o$3092 0)) (jolt-hash-map _o$3091 _o$3092))) (_o$3109 "run!") (_o$3110 (let* ((_o$3093 (keyword #f "epos")) (_o$3094 0)) (jolt-hash-map _o$3093 _o$3094))) (_o$3111 "mapcat") (_o$3112 (let* ((_o$3095 (keyword #f "epos")) (_o$3096 0)) (jolt-hash-map _o$3095 _o$3096)))) (jolt-hash-map _o$3097 _o$3098 _o$3099 _o$3100 _o$3101 _o$3102 _o$3103 _o$3104 _o$3105 _o$3106 _o$3107 _o$3108 _o$3109 _o$3110 _o$3111 _o$3112)) (jolt-hash-map (keyword #f "private") #t))) + (def-var-with-meta! "jolt.passes.types" "hof-table" (let* ((_o$2982 "map") (_o$2983 (let* ((_o$2966 (keyword #f "epos")) (_o$2967 0)) (jolt-hash-map _o$2966 _o$2967))) (_o$2984 "mapv") (_o$2985 (let* ((_o$2968 (keyword #f "epos")) (_o$2969 0)) (jolt-hash-map _o$2968 _o$2969))) (_o$2986 "filter") (_o$2987 (let* ((_o$2970 (keyword #f "epos")) (_o$2971 0)) (jolt-hash-map _o$2970 _o$2971))) (_o$2988 "filterv") (_o$2989 (let* ((_o$2972 (keyword #f "epos")) (_o$2973 0)) (jolt-hash-map _o$2972 _o$2973))) (_o$2990 "keep") (_o$2991 (let* ((_o$2974 (keyword #f "epos")) (_o$2975 0)) (jolt-hash-map _o$2974 _o$2975))) (_o$2992 "remove") (_o$2993 (let* ((_o$2976 (keyword #f "epos")) (_o$2977 0)) (jolt-hash-map _o$2976 _o$2977))) (_o$2994 "run!") (_o$2995 (let* ((_o$2978 (keyword #f "epos")) (_o$2979 0)) (jolt-hash-map _o$2978 _o$2979))) (_o$2996 "mapcat") (_o$2997 (let* ((_o$2980 (keyword #f "epos")) (_o$2981 0)) (jolt-hash-map _o$2980 _o$2981)))) (jolt-hash-map _o$2982 _o$2983 _o$2984 _o$2985 _o$2986 _o$2987 _o$2988 _o$2989 _o$2990 _o$2991 _o$2992 _o$2993 _o$2994 _o$2995 _o$2996 _o$2997)) (jolt-hash-map (keyword #f "private") #t))) (guard (e (#t #f)) - (def-var! "jolt.passes.types" "infer-fn-seeded" (letrec ((infer-fn-seeded (lambda (node seeds tenv env) (let fnrec3113 ((node node) (seeds seeds) (tenv tenv) (env env)) (let* ((res (let* ((_a$3124 (var-deref "clojure.core" "mapv")) (_a$3125 (lambda (a) (let fnrec3114 ((a a)) (let* ((params (jolt-get a (keyword #f "params"))) (pe (let* ((_a$3119 (lambda (e i) (let fnrec3115 ((e e) (i i)) (let* ((_a$3116 e) (_a$3117 (jolt-nth params i)) (_a$3118 (let* ((s (jolt-get seeds i))) (if (jolt-truthy? s) s (keyword #f "any"))))) (jolt-assoc _a$3116 _a$3117 _a$3118))))) (_a$3120 tenv) (_a$3121 (jolt-range (jolt-count params)))) (jolt-reduce _a$3119 _a$3120 _a$3121))) (pe (if (jolt-truthy? (jolt-get a (keyword #f "rest"))) (jolt-assoc pe (jolt-get a (keyword #f "rest")) (keyword #f "any")) pe)) (br (jolt-invoke (var-deref "jolt.passes.types" "infer") (jolt-get a (keyword #f "body")) pe env))) (let* ((_o$3122 (jolt-invoke (var-deref "jolt.passes.types" "ty") br)) (_o$3123 (jolt-assoc a (keyword #f "body") (jolt-invoke (var-deref "jolt.passes.types" "nd") br)))) (jolt-vector _o$3122 _o$3123)))))) (_a$3126 (jolt-get node (keyword #f "arities")))) (jolt-invoke _a$3124 _a$3125 _a$3126))) (rets (jolt-invoke (var-deref "clojure.core" "mapv") (lambda (r) (let fnrec3127 ((r r)) (jolt-invoke (var-deref "jolt.passes.types" "ty") r))) res)) (ret (if (jolt-empty? rets) (keyword #f "any") (let* ((_a$3128 (var-deref "jolt.passes.types.lattice" "join")) (_a$3129 (jolt-first rets)) (_a$3130 (jolt-rest rets))) (jolt-reduce _a$3128 _a$3129 _a$3130))))) (let* ((_o$3132 ret) (_o$3133 (jolt-assoc node (keyword #f "arities") (jolt-invoke (var-deref "clojure.core" "mapv") (lambda (r) (let fnrec3131 ((r r)) (jolt-invoke (var-deref "jolt.passes.types" "nd") r))) res)))) (jolt-vector _o$3132 _o$3133))))))) infer-fn-seeded))) + (def-var! "jolt.passes.types" "infer-fn-seeded" (letrec ((infer-fn-seeded (lambda (node seeds tenv env) (let fnrec2998 ((node node) (seeds seeds) (tenv tenv) (env env)) (let* ((res (let* ((_a$3009 (var-deref "clojure.core" "mapv")) (_a$3010 (lambda (a) (let fnrec2999 ((a a)) (let* ((params (jolt-get a (keyword #f "params"))) (pe (let* ((_a$3004 (lambda (e i) (let fnrec3000 ((e e) (i i)) (let* ((_a$3001 e) (_a$3002 (jolt-nth params i)) (_a$3003 (let* ((s (jolt-get seeds i))) (if (jolt-truthy? s) s (keyword #f "any"))))) (jolt-assoc _a$3001 _a$3002 _a$3003))))) (_a$3005 tenv) (_a$3006 (jolt-range (jolt-count params)))) (jolt-reduce _a$3004 _a$3005 _a$3006))) (pe (if (jolt-truthy? (jolt-get a (keyword #f "rest"))) (jolt-assoc pe (jolt-get a (keyword #f "rest")) (keyword #f "any")) pe)) (br (jolt-invoke (var-deref "jolt.passes.types" "infer") (jolt-get a (keyword #f "body")) pe env))) (let* ((_o$3007 (jolt-invoke (var-deref "jolt.passes.types" "ty") br)) (_o$3008 (jolt-assoc a (keyword #f "body") (jolt-invoke (var-deref "jolt.passes.types" "nd") br)))) (jolt-vector _o$3007 _o$3008)))))) (_a$3011 (jolt-get node (keyword #f "arities")))) (jolt-invoke _a$3009 _a$3010 _a$3011))) (rets (jolt-invoke (var-deref "clojure.core" "mapv") (lambda (r) (let fnrec3012 ((r r)) (jolt-invoke (var-deref "jolt.passes.types" "ty") r))) res)) (ret (if (jolt-empty? rets) (keyword #f "any") (let* ((_a$3013 (var-deref "jolt.passes.types.lattice" "join")) (_a$3014 (jolt-first rets)) (_a$3015 (jolt-rest rets))) (jolt-reduce _a$3013 _a$3014 _a$3015))))) (let* ((_o$3017 ret) (_o$3018 (jolt-assoc node (keyword #f "arities") (jolt-invoke (var-deref "clojure.core" "mapv") (lambda (r) (let fnrec3016 ((r r)) (jolt-invoke (var-deref "jolt.passes.types" "nd") r))) res)))) (jolt-vector _o$3017 _o$3018))))))) infer-fn-seeded))) (guard (e (#t #f)) - (def-var! "jolt.passes.types" "infer-pred-fold" (letrec ((infer-pred-fold (lambda (node fnode cn args tenv env) (let fnrec3134 ((node node) (fnode fnode) (cn cn) (args args) (tenv tenv) (env env)) (let* ((ar (jolt-invoke (var-deref "jolt.passes.types" "infer") (jolt-nth args 0) tenv env)) (v (jolt-invoke (var-deref "jolt.passes.types" "pred-on") cn (jolt-invoke (var-deref "jolt.passes.types" "ty") ar)))) (if (jolt-truthy? (let* ((and__13__auto (jolt-not (jolt-invoke (var-deref "clojure.core" "nil?") v)))) (if (jolt-truthy? and__13__auto) (jolt-invoke (var-deref "jolt.passes.types" "pure-node?") (jolt-invoke (var-deref "jolt.passes.types" "nd") ar)) and__13__auto))) (let* ((_o$3139 (keyword #f "any")) (_o$3140 (let* ((_o$3135 (keyword #f "op")) (_o$3136 (keyword #f "const")) (_o$3137 (keyword #f "val")) (_o$3138 v)) (jolt-hash-map _o$3135 _o$3136 _o$3137 _o$3138)))) (jolt-vector _o$3139 _o$3140)) (let* ((_o$3141 (jolt-invoke (var-deref "jolt.passes.types" "call-ret-type") fnode env)) (_o$3142 (jolt-assoc node (keyword #f "args") (jolt-vector (jolt-invoke (var-deref "jolt.passes.types" "nd") ar))))) (jolt-vector _o$3141 _o$3142)))))))) infer-pred-fold))) + (def-var! "jolt.passes.types" "infer-pred-fold" (letrec ((infer-pred-fold (lambda (node fnode cn args tenv env) (let fnrec3019 ((node node) (fnode fnode) (cn cn) (args args) (tenv tenv) (env env)) (let* ((ar (jolt-invoke (var-deref "jolt.passes.types" "infer") (jolt-nth args 0) tenv env)) (v (jolt-invoke (var-deref "jolt.passes.types" "pred-on") cn (jolt-invoke (var-deref "jolt.passes.types" "ty") ar)))) (if (jolt-truthy? (let* ((and__13__auto (jolt-not (jolt-invoke (var-deref "clojure.core" "nil?") v)))) (if (jolt-truthy? and__13__auto) (jolt-invoke (var-deref "jolt.passes.types" "pure-node?") (jolt-invoke (var-deref "jolt.passes.types" "nd") ar)) and__13__auto))) (let* ((_o$3024 (keyword #f "any")) (_o$3025 (let* ((_o$3020 (keyword #f "op")) (_o$3021 (keyword #f "const")) (_o$3022 (keyword #f "val")) (_o$3023 v)) (jolt-hash-map _o$3020 _o$3021 _o$3022 _o$3023)))) (jolt-vector _o$3024 _o$3025)) (let* ((_o$3026 (jolt-invoke (var-deref "jolt.passes.types" "call-ret-type") fnode env)) (_o$3027 (jolt-assoc node (keyword #f "args") (jolt-vector (jolt-invoke (var-deref "jolt.passes.types" "nd") ar))))) (jolt-vector _o$3026 _o$3027)))))))) infer-pred-fold))) (guard (e (#t #f)) - (def-var! "jolt.passes.types" "infer-kw-lookup" (letrec ((infer-kw-lookup (lambda (node fnode args n tenv env) (let fnrec3143 ((node node) (fnode fnode) (args args) (n n) (tenv tenv) (env env)) (let* ((mr (jolt-invoke (var-deref "jolt.passes.types" "infer") (jolt-nth args 0) tenv env)) (mt (jolt-invoke (var-deref "jolt.passes.types" "ty") mr)) (msub (if (jolt-truthy? (jolt-invoke (var-deref "jolt.passes.types.lattice" "struct-safe?") mt)) (jolt-invoke (var-deref "jolt.passes.types.lattice" "mark-struct") (jolt-invoke (var-deref "jolt.passes.types" "nd") mr) mt) (jolt-invoke (var-deref "jolt.passes.types" "nd") mr))) (ft (jolt-invoke (var-deref "jolt.passes.types.lattice" "field-type") mt (jolt-get fnode (keyword #f "val")))) (dr (if (jolt= n 2) (jolt-invoke (var-deref "jolt.passes.types" "infer") (jolt-nth args 1) tenv env) jolt-nil))) (let* ((_o$3146 (if (jolt-truthy? dr) (jolt-invoke (var-deref "jolt.passes.types.lattice" "join") ft (jolt-invoke (var-deref "jolt.passes.types" "ty") dr)) ft)) (_o$3147 (jolt-assoc node (keyword #f "args") (if (jolt-truthy? dr) (let* ((_o$3144 msub) (_o$3145 (jolt-invoke (var-deref "jolt.passes.types" "nd") dr))) (jolt-vector _o$3144 _o$3145)) (jolt-vector msub))))) (jolt-vector _o$3146 _o$3147))))))) infer-kw-lookup))) + (def-var! "jolt.passes.types" "infer-kw-lookup" (letrec ((infer-kw-lookup (lambda (node fnode args n tenv env) (let fnrec3028 ((node node) (fnode fnode) (args args) (n n) (tenv tenv) (env env)) (let* ((mr (jolt-invoke (var-deref "jolt.passes.types" "infer") (jolt-nth args 0) tenv env)) (mt (jolt-invoke (var-deref "jolt.passes.types" "ty") mr)) (msub (if (jolt-truthy? (jolt-invoke (var-deref "jolt.passes.types.lattice" "struct-safe?") mt)) (jolt-invoke (var-deref "jolt.passes.types.lattice" "mark-struct") (jolt-invoke (var-deref "jolt.passes.types" "nd") mr) mt) (jolt-invoke (var-deref "jolt.passes.types" "nd") mr))) (ft (jolt-invoke (var-deref "jolt.passes.types.lattice" "field-type") mt (jolt-get fnode (keyword #f "val")))) (dr (if (jolt= n 2) (jolt-invoke (var-deref "jolt.passes.types" "infer") (jolt-nth args 1) tenv env) jolt-nil))) (let* ((_o$3031 (if (jolt-truthy? dr) (jolt-invoke (var-deref "jolt.passes.types.lattice" "join") ft (jolt-invoke (var-deref "jolt.passes.types" "ty") dr)) ft)) (_o$3032 (jolt-assoc node (keyword #f "args") (if (jolt-truthy? dr) (let* ((_o$3029 msub) (_o$3030 (jolt-invoke (var-deref "jolt.passes.types" "nd") dr))) (jolt-vector _o$3029 _o$3030)) (jolt-vector msub))))) (jolt-vector _o$3031 _o$3032))))))) infer-kw-lookup))) (guard (e (#t #f)) - (def-var! "jolt.passes.types" "infer-get-lookup" (letrec ((infer-get-lookup (lambda (node args n tenv env) (let fnrec3148 ((node node) (args args) (n n) (tenv tenv) (env env)) (let* ((mr (jolt-invoke (var-deref "jolt.passes.types" "infer") (jolt-nth args 0) tenv env)) (mt (jolt-invoke (var-deref "jolt.passes.types" "ty") mr)) (msub (if (jolt-truthy? (jolt-invoke (var-deref "jolt.passes.types.lattice" "struct-safe?") mt)) (jolt-invoke (var-deref "jolt.passes.types.lattice" "mark-struct") (jolt-invoke (var-deref "jolt.passes.types" "nd") mr) mt) (jolt-invoke (var-deref "jolt.passes.types" "nd") mr))) (kr (jolt-invoke (var-deref "jolt.passes.types" "infer") (jolt-nth args 1) tenv env)) (ft (jolt-invoke (var-deref "jolt.passes.types.lattice" "field-type") mt (jolt-get (jolt-nth args 1) (keyword #f "val")))) (dr (if (jolt= n 3) (jolt-invoke (var-deref "jolt.passes.types" "infer") (jolt-nth args 2) tenv env) jolt-nil))) (let* ((_o$3154 (if (jolt-truthy? dr) (jolt-invoke (var-deref "jolt.passes.types.lattice" "join") ft (jolt-invoke (var-deref "jolt.passes.types" "ty") dr)) ft)) (_o$3155 (jolt-assoc node (keyword #f "args") (if (jolt-truthy? dr) (let* ((_o$3149 msub) (_o$3150 (jolt-invoke (var-deref "jolt.passes.types" "nd") kr)) (_o$3151 (jolt-invoke (var-deref "jolt.passes.types" "nd") dr))) (jolt-vector _o$3149 _o$3150 _o$3151)) (let* ((_o$3152 msub) (_o$3153 (jolt-invoke (var-deref "jolt.passes.types" "nd") kr))) (jolt-vector _o$3152 _o$3153)))))) (jolt-vector _o$3154 _o$3155))))))) infer-get-lookup))) + (def-var! "jolt.passes.types" "infer-get-lookup" (letrec ((infer-get-lookup (lambda (node args n tenv env) (let fnrec3033 ((node node) (args args) (n n) (tenv tenv) (env env)) (let* ((mr (jolt-invoke (var-deref "jolt.passes.types" "infer") (jolt-nth args 0) tenv env)) (mt (jolt-invoke (var-deref "jolt.passes.types" "ty") mr)) (msub (if (jolt-truthy? (jolt-invoke (var-deref "jolt.passes.types.lattice" "struct-safe?") mt)) (jolt-invoke (var-deref "jolt.passes.types.lattice" "mark-struct") (jolt-invoke (var-deref "jolt.passes.types" "nd") mr) mt) (jolt-invoke (var-deref "jolt.passes.types" "nd") mr))) (kr (jolt-invoke (var-deref "jolt.passes.types" "infer") (jolt-nth args 1) tenv env)) (ft (jolt-invoke (var-deref "jolt.passes.types.lattice" "field-type") mt (jolt-get (jolt-nth args 1) (keyword #f "val")))) (dr (if (jolt= n 3) (jolt-invoke (var-deref "jolt.passes.types" "infer") (jolt-nth args 2) tenv env) jolt-nil))) (let* ((_o$3039 (if (jolt-truthy? dr) (jolt-invoke (var-deref "jolt.passes.types.lattice" "join") ft (jolt-invoke (var-deref "jolt.passes.types" "ty") dr)) ft)) (_o$3040 (jolt-assoc node (keyword #f "args") (if (jolt-truthy? dr) (let* ((_o$3034 msub) (_o$3035 (jolt-invoke (var-deref "jolt.passes.types" "nd") kr)) (_o$3036 (jolt-invoke (var-deref "jolt.passes.types" "nd") dr))) (jolt-vector _o$3034 _o$3035 _o$3036)) (let* ((_o$3037 msub) (_o$3038 (jolt-invoke (var-deref "jolt.passes.types" "nd") kr))) (jolt-vector _o$3037 _o$3038)))))) (jolt-vector _o$3039 _o$3040))))))) infer-get-lookup))) (guard (e (#t #f)) - (def-var! "jolt.passes.types" "infer-reduce-hof" (letrec ((infer-reduce-hof (lambda (node args n tenv env) (let fnrec3156 ((node node) (args args) (n n) (tenv tenv) (env env)) (let* ((three (>= n 3)) (coll-r (jolt-invoke (var-deref "jolt.passes.types" "infer") (jolt-nth args (if (jolt-truthy? three) 2 1)) tenv env)) (init-r (if (jolt-truthy? three) (jolt-invoke (var-deref "jolt.passes.types" "infer") (jolt-nth args 1) tenv env) jolt-nil)) (et (let* ((ct (jolt-invoke (var-deref "jolt.passes.types" "ty") coll-r))) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.passes.types.lattice" "vec-type?") ct)) (jolt-invoke (var-deref "jolt.passes.types.lattice" "velem") ct) (keyword #f "any")))) (init-t (if (jolt-truthy? init-r) (jolt-invoke (var-deref "jolt.passes.types" "ty") init-r) (keyword #f "any"))) (fn-r (let* ((_a$3161 (var-deref "jolt.passes.types" "infer-fn-seeded")) (_a$3162 (jolt-nth args 0)) (_a$3163 (let* ((_o$3157 0) (_o$3158 init-t) (_o$3159 1) (_o$3160 et)) (jolt-hash-map _o$3157 _o$3158 _o$3159 _o$3160))) (_a$3164 tenv) (_a$3165 env)) (jolt-invoke _a$3161 _a$3162 _a$3163 _a$3164 _a$3165)))) (let* ((_o$3171 (jolt-invoke (var-deref "jolt.passes.types.lattice" "join") init-t (jolt-invoke (var-deref "jolt.passes.types" "ty") fn-r))) (_o$3172 (jolt-assoc node (keyword #f "args") (if (jolt-truthy? three) (let* ((_o$3166 (jolt-invoke (var-deref "jolt.passes.types" "nd") fn-r)) (_o$3167 (jolt-invoke (var-deref "jolt.passes.types" "nd") init-r)) (_o$3168 (jolt-invoke (var-deref "jolt.passes.types" "nd") coll-r))) (jolt-vector _o$3166 _o$3167 _o$3168)) (let* ((_o$3169 (jolt-invoke (var-deref "jolt.passes.types" "nd") fn-r)) (_o$3170 (jolt-invoke (var-deref "jolt.passes.types" "nd") coll-r))) (jolt-vector _o$3169 _o$3170)))))) (jolt-vector _o$3171 _o$3172))))))) infer-reduce-hof))) + (def-var! "jolt.passes.types" "infer-reduce-hof" (letrec ((infer-reduce-hof (lambda (node args n tenv env) (let fnrec3041 ((node node) (args args) (n n) (tenv tenv) (env env)) (let* ((three (>= n 3)) (coll-r (jolt-invoke (var-deref "jolt.passes.types" "infer") (jolt-nth args (if (jolt-truthy? three) 2 1)) tenv env)) (init-r (if (jolt-truthy? three) (jolt-invoke (var-deref "jolt.passes.types" "infer") (jolt-nth args 1) tenv env) jolt-nil)) (et (let* ((ct (jolt-invoke (var-deref "jolt.passes.types" "ty") coll-r))) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.passes.types.lattice" "vec-type?") ct)) (jolt-invoke (var-deref "jolt.passes.types.lattice" "velem") ct) (keyword #f "any")))) (init-t (if (jolt-truthy? init-r) (jolt-invoke (var-deref "jolt.passes.types" "ty") init-r) (keyword #f "any"))) (fn-r (let* ((_a$3046 (var-deref "jolt.passes.types" "infer-fn-seeded")) (_a$3047 (jolt-nth args 0)) (_a$3048 (let* ((_o$3042 0) (_o$3043 init-t) (_o$3044 1) (_o$3045 et)) (jolt-hash-map _o$3042 _o$3043 _o$3044 _o$3045))) (_a$3049 tenv) (_a$3050 env)) (jolt-invoke _a$3046 _a$3047 _a$3048 _a$3049 _a$3050)))) (let* ((_o$3056 (jolt-invoke (var-deref "jolt.passes.types.lattice" "join") init-t (jolt-invoke (var-deref "jolt.passes.types" "ty") fn-r))) (_o$3057 (jolt-assoc node (keyword #f "args") (if (jolt-truthy? three) (let* ((_o$3051 (jolt-invoke (var-deref "jolt.passes.types" "nd") fn-r)) (_o$3052 (jolt-invoke (var-deref "jolt.passes.types" "nd") init-r)) (_o$3053 (jolt-invoke (var-deref "jolt.passes.types" "nd") coll-r))) (jolt-vector _o$3051 _o$3052 _o$3053)) (let* ((_o$3054 (jolt-invoke (var-deref "jolt.passes.types" "nd") fn-r)) (_o$3055 (jolt-invoke (var-deref "jolt.passes.types" "nd") coll-r))) (jolt-vector _o$3054 _o$3055)))))) (jolt-vector _o$3056 _o$3057))))))) infer-reduce-hof))) (guard (e (#t #f)) - (def-var! "jolt.passes.types" "infer-seq-hof" (letrec ((infer-seq-hof (lambda (node cn args tenv env) (let fnrec3173 ((node node) (cn cn) (args args) (tenv tenv) (env env)) (let* ((coll-r (jolt-invoke (var-deref "jolt.passes.types" "infer") (jolt-nth args 1) tenv env)) (et (let* ((ct (jolt-invoke (var-deref "jolt.passes.types" "ty") coll-r))) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.passes.types.lattice" "vec-type?") ct)) (jolt-invoke (var-deref "jolt.passes.types.lattice" "velem") ct) (keyword #f "any")))) (fn-r (let* ((_a$3176 (var-deref "jolt.passes.types" "infer-fn-seeded")) (_a$3177 (jolt-nth args 0)) (_a$3178 (let* ((_o$3174 (jolt-get (jolt-get (var-deref "jolt.passes.types" "hof-table") cn) (keyword #f "epos"))) (_o$3175 et)) (jolt-hash-map _o$3174 _o$3175))) (_a$3179 tenv) (_a$3180 env)) (jolt-invoke _a$3176 _a$3177 _a$3178 _a$3179 _a$3180))) (rt (if (jolt= cn "mapv") (jolt-invoke (var-deref "jolt.passes.types.lattice" "mk-vec") (jolt-invoke (var-deref "jolt.passes.types" "ty") fn-r)) (if (jolt= cn "filterv") (jolt-invoke (var-deref "jolt.passes.types.lattice" "mk-vec") et) (if (jolt-truthy? (keyword #f "else")) (keyword #f "any") jolt-nil))))) (let* ((_o$3183 rt) (_o$3184 (jolt-assoc node (keyword #f "args") (let* ((_o$3181 (jolt-invoke (var-deref "jolt.passes.types" "nd") fn-r)) (_o$3182 (jolt-invoke (var-deref "jolt.passes.types" "nd") coll-r))) (jolt-vector _o$3181 _o$3182))))) (jolt-vector _o$3183 _o$3184))))))) infer-seq-hof))) + (def-var! "jolt.passes.types" "infer-seq-hof" (letrec ((infer-seq-hof (lambda (node cn args tenv env) (let fnrec3058 ((node node) (cn cn) (args args) (tenv tenv) (env env)) (let* ((coll-r (jolt-invoke (var-deref "jolt.passes.types" "infer") (jolt-nth args 1) tenv env)) (et (let* ((ct (jolt-invoke (var-deref "jolt.passes.types" "ty") coll-r))) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.passes.types.lattice" "vec-type?") ct)) (jolt-invoke (var-deref "jolt.passes.types.lattice" "velem") ct) (keyword #f "any")))) (fn-r (let* ((_a$3061 (var-deref "jolt.passes.types" "infer-fn-seeded")) (_a$3062 (jolt-nth args 0)) (_a$3063 (let* ((_o$3059 (jolt-get (jolt-get (var-deref "jolt.passes.types" "hof-table") cn) (keyword #f "epos"))) (_o$3060 et)) (jolt-hash-map _o$3059 _o$3060))) (_a$3064 tenv) (_a$3065 env)) (jolt-invoke _a$3061 _a$3062 _a$3063 _a$3064 _a$3065))) (rt (if (jolt= cn "mapv") (jolt-invoke (var-deref "jolt.passes.types.lattice" "mk-vec") (jolt-invoke (var-deref "jolt.passes.types" "ty") fn-r)) (if (jolt= cn "filterv") (jolt-invoke (var-deref "jolt.passes.types.lattice" "mk-vec") et) (if (jolt-truthy? (keyword #f "else")) (keyword #f "any") jolt-nil))))) (let* ((_o$3068 rt) (_o$3069 (jolt-assoc node (keyword #f "args") (let* ((_o$3066 (jolt-invoke (var-deref "jolt.passes.types" "nd") fn-r)) (_o$3067 (jolt-invoke (var-deref "jolt.passes.types" "nd") coll-r))) (jolt-vector _o$3066 _o$3067))))) (jolt-vector _o$3068 _o$3069))))))) infer-seq-hof))) (guard (e (#t #f)) - (def-var! "jolt.passes.types" "infer-conj-into" (letrec ((infer-conj-into (lambda (node fnode cn args n tenv env) (let fnrec3185 ((node node) (fnode fnode) (cn cn) (args args) (n n) (tenv tenv) (env env)) (let* ((ares (jolt-invoke (var-deref "clojure.core" "mapv") (lambda (a) (let fnrec3186 ((a a)) (jolt-invoke (var-deref "jolt.passes.types" "infer") a tenv env))) args)) (base (jolt-invoke (var-deref "jolt.passes.types" "ty") (jolt-nth ares 0))) (rest-ts (let* ((_a$3188 (var-deref "clojure.core" "mapv")) (_a$3189 (lambda (r) (let fnrec3187 ((r r)) (jolt-invoke (var-deref "jolt.passes.types" "ty") r)))) (_a$3190 (jolt-rest ares))) (jolt-invoke _a$3188 _a$3189 _a$3190))) (rt (if (jolt-truthy? (let* ((and__13__auto (jolt= cn "conj"))) (if (jolt-truthy? and__13__auto) (jolt-invoke (var-deref "jolt.passes.types.lattice" "vec-type?") base) and__13__auto))) (jolt-invoke (var-deref "jolt.passes.types.lattice" "mk-vec") (jolt-reduce (var-deref "jolt.passes.types.lattice" "join") (jolt-invoke (var-deref "jolt.passes.types.lattice" "velem") base) rest-ts)) (if (jolt-truthy? (let* ((and__13__auto (jolt= cn "into"))) (if (jolt-truthy? and__13__auto) (let* ((and__13__auto (jolt-invoke (var-deref "jolt.passes.types.lattice" "vec-type?") base))) (if (jolt-truthy? and__13__auto) (let* ((and__13__auto (jolt= 2 n))) (if (jolt-truthy? and__13__auto) (jolt-invoke (var-deref "jolt.passes.types.lattice" "vec-type?") (jolt-nth rest-ts 0)) and__13__auto)) and__13__auto)) and__13__auto))) (jolt-invoke (var-deref "jolt.passes.types.lattice" "mk-vec") (let* ((_a$3191 (var-deref "jolt.passes.types.lattice" "join")) (_a$3192 (jolt-invoke (var-deref "jolt.passes.types.lattice" "velem") base)) (_a$3193 (jolt-invoke (var-deref "jolt.passes.types.lattice" "velem") (jolt-nth rest-ts 0)))) (jolt-invoke _a$3191 _a$3192 _a$3193))) (if (jolt-truthy? (keyword #f "else")) (jolt-invoke (var-deref "jolt.passes.types" "call-ret-type") fnode env) jolt-nil))))) (let* ((_o$3195 rt) (_o$3196 (jolt-assoc node (keyword #f "args") (jolt-invoke (var-deref "clojure.core" "mapv") (lambda (r) (let fnrec3194 ((r r)) (jolt-invoke (var-deref "jolt.passes.types" "nd") r))) ares)))) (jolt-vector _o$3195 _o$3196))))))) infer-conj-into))) + (def-var! "jolt.passes.types" "infer-conj-into" (letrec ((infer-conj-into (lambda (node fnode cn args n tenv env) (let fnrec3070 ((node node) (fnode fnode) (cn cn) (args args) (n n) (tenv tenv) (env env)) (let* ((ares (jolt-invoke (var-deref "clojure.core" "mapv") (lambda (a) (let fnrec3071 ((a a)) (jolt-invoke (var-deref "jolt.passes.types" "infer") a tenv env))) args)) (base (jolt-invoke (var-deref "jolt.passes.types" "ty") (jolt-nth ares 0))) (rest-ts (let* ((_a$3073 (var-deref "clojure.core" "mapv")) (_a$3074 (lambda (r) (let fnrec3072 ((r r)) (jolt-invoke (var-deref "jolt.passes.types" "ty") r)))) (_a$3075 (jolt-rest ares))) (jolt-invoke _a$3073 _a$3074 _a$3075))) (rt (if (jolt-truthy? (let* ((and__13__auto (jolt= cn "conj"))) (if (jolt-truthy? and__13__auto) (jolt-invoke (var-deref "jolt.passes.types.lattice" "vec-type?") base) and__13__auto))) (jolt-invoke (var-deref "jolt.passes.types.lattice" "mk-vec") (jolt-reduce (var-deref "jolt.passes.types.lattice" "join") (jolt-invoke (var-deref "jolt.passes.types.lattice" "velem") base) rest-ts)) (if (jolt-truthy? (let* ((and__13__auto (jolt= cn "into"))) (if (jolt-truthy? and__13__auto) (let* ((and__13__auto (jolt-invoke (var-deref "jolt.passes.types.lattice" "vec-type?") base))) (if (jolt-truthy? and__13__auto) (let* ((and__13__auto (jolt= 2 n))) (if (jolt-truthy? and__13__auto) (jolt-invoke (var-deref "jolt.passes.types.lattice" "vec-type?") (jolt-nth rest-ts 0)) and__13__auto)) and__13__auto)) and__13__auto))) (jolt-invoke (var-deref "jolt.passes.types.lattice" "mk-vec") (let* ((_a$3076 (var-deref "jolt.passes.types.lattice" "join")) (_a$3077 (jolt-invoke (var-deref "jolt.passes.types.lattice" "velem") base)) (_a$3078 (jolt-invoke (var-deref "jolt.passes.types.lattice" "velem") (jolt-nth rest-ts 0)))) (jolt-invoke _a$3076 _a$3077 _a$3078))) (if (jolt-truthy? (keyword #f "else")) (jolt-invoke (var-deref "jolt.passes.types" "call-ret-type") fnode env) jolt-nil))))) (let* ((_o$3080 rt) (_o$3081 (jolt-assoc node (keyword #f "args") (jolt-invoke (var-deref "clojure.core" "mapv") (lambda (r) (let fnrec3079 ((r r)) (jolt-invoke (var-deref "jolt.passes.types" "nd") r))) ares)))) (jolt-vector _o$3080 _o$3081))))))) infer-conj-into))) (guard (e (#t #f)) - (def-var! "jolt.passes.types" "infer-call" (letrec ((infer-call (lambda (node fnode iscall-var cn args n tenv env) (let fnrec3197 ((node node) (fnode fnode) (iscall-var iscall-var) (cn cn) (args args) (n n) (tenv tenv) (env env)) (let* ((fr (if (jolt-not iscall-var) (jolt-invoke (var-deref "jolt.passes.types" "infer") fnode tenv env) jolt-nil)) (fnode_PRIME_ (if (jolt-truthy? iscall-var) fnode (jolt-invoke (var-deref "jolt.passes.types" "nd") fr))) (callee-t (if (jolt-truthy? iscall-var) (let* ((_a$3198 (jolt-get env (keyword #f "vtypes"))) (_a$3199 (jolt-invoke (var-deref "jolt.passes.types" "var-key") fnode))) (jolt-get _a$3198 _a$3199)) (jolt-invoke (var-deref "jolt.passes.types" "ty") fr))) (ares (jolt-invoke (var-deref "clojure.core" "mapv") (lambda (a) (let fnrec3200 ((a a)) (jolt-invoke (var-deref "jolt.passes.types" "infer") a tenv env))) args))) (begin (if (jolt-truthy? iscall-var) (let* ((_a$3204 (var-deref "clojure.core" "swap!")) (_a$3205 (jolt-get env (keyword #f "calls"))) (_a$3206 jolt-conj) (_a$3207 (let* ((_o$3202 (jolt-invoke (var-deref "jolt.passes.types" "var-key") fnode)) (_o$3203 (jolt-invoke (var-deref "clojure.core" "mapv") (lambda (r) (let fnrec3201 ((r r)) (jolt-invoke (var-deref "jolt.passes.types" "ty") r))) ares))) (jolt-vector _o$3202 _o$3203)))) (jolt-invoke _a$3204 _a$3205 _a$3206 _a$3207)) jolt-nil) (if (jolt-truthy? (jolt-get env (keyword #f "checking?"))) (let* ((ats (jolt-invoke (var-deref "clojure.core" "mapv") (lambda (r) (let fnrec3208 ((r r)) (jolt-invoke (var-deref "jolt.passes.types" "ty") r))) ares)) (pos (jolt-get node (keyword #f "pos")))) (begin (if (jolt-truthy? cn) (jolt-invoke (var-deref "jolt.passes.types" "check-invoke") cn args ats pos env) jolt-nil) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.passes.types" "not-callable?") callee-t)) (let* ((_a$3217 (var-deref "clojure.core" "swap!")) (_a$3218 (jolt-get env (keyword #f "diags"))) (_a$3219 jolt-conj) (_a$3220 (let* ((_o$3209 (keyword #f "op")) (_o$3210 (keyword #f "call")) (_o$3211 (keyword #f "type")) (_o$3212 (jolt-invoke (var-deref "jolt.passes.types" "type-name") callee-t)) (_o$3213 (keyword #f "pos")) (_o$3214 pos) (_o$3215 (keyword #f "msg")) (_o$3216 (jolt-invoke (var-deref "clojure.core" "str") "cannot call " (jolt-invoke (var-deref "jolt.passes.types" "type-name") callee-t) " as a function"))) (jolt-hash-map _o$3209 _o$3210 _o$3211 _o$3212 _o$3213 _o$3214 _o$3215 _o$3216)))) (jolt-invoke _a$3217 _a$3218 _a$3219 _a$3220)) jolt-nil) (if (jolt-truthy? (let* ((and__13__auto (jolt-get env (keyword #f "strict?")))) (if (jolt-truthy? and__13__auto) iscall-var and__13__auto))) (let* ((k (jolt-invoke (var-deref "jolt.passes.types" "var-key") fnode)) (usig (jolt-get (jolt-invoke (var-deref "clojure.core" "deref") (jolt-get env (keyword #f "user-sigs"))) k))) (if (jolt-truthy? usig) (jolt-invoke (var-deref "jolt.passes.types" "check-user-call") k usig ats pos env) jolt-nil)) jolt-nil))) jolt-nil) (let* ((pm (let* ((and__13__auto iscall-var)) (if (jolt-truthy? and__13__auto) (let* ((_a$3221 (jolt-get env (keyword #f "protocol-methods"))) (_a$3222 (jolt-invoke (var-deref "jolt.passes.types" "var-key") fnode))) (jolt-get _a$3221 _a$3222)) and__13__auto))) (rtype (if (jolt-truthy? (let* ((and__13__auto pm)) (if (jolt-truthy? and__13__auto) (jolt-pos? n) and__13__auto))) (jolt-get (jolt-invoke (var-deref "jolt.passes.types" "ty") (jolt-nth ares 0)) (keyword #f "type")) jolt-nil)) (base (jolt-assoc node (keyword #f "fn") fnode_PRIME_ (keyword #f "args") (jolt-invoke (var-deref "clojure.core" "mapv") (lambda (r) (let fnrec3223 ((r r)) (jolt-invoke (var-deref "jolt.passes.types" "nd") r))) ares)))) (let* ((_o$3231 (if (jolt= cn "range") (jolt-invoke (var-deref "jolt.passes.types.lattice" "mk-vec") (keyword #f "num")) (if (jolt-truthy? (let* ((and__13__auto cn)) (if (jolt-truthy? and__13__auto) (let* ((and__13__auto (jolt-contains? (var-deref "jolt.passes.types" "elem-fns") cn))) (if (jolt-truthy? and__13__auto) (> n 0) and__13__auto)) and__13__auto))) (let* ((a0 (jolt-invoke (var-deref "jolt.passes.types" "ty") (jolt-nth ares 0)))) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.passes.types.lattice" "vec-type?") a0)) (jolt-invoke (var-deref "jolt.passes.types.lattice" "velem") a0) (keyword #f "any"))) (if (jolt-truthy? (keyword #f "else")) (jolt-invoke (var-deref "jolt.passes.types" "call-ret-type") fnode env) jolt-nil)))) (_o$3232 (if (jolt-truthy? rtype) (let* ((_a$3224 base) (_a$3225 (keyword #f "devirt-type")) (_a$3226 rtype) (_a$3227 (keyword #f "devirt-proto")) (_a$3228 (jolt-nth pm 0)) (_a$3229 (keyword #f "devirt-method")) (_a$3230 (jolt-nth pm 1))) (jolt-assoc _a$3224 _a$3225 _a$3226 _a$3227 _a$3228 _a$3229 _a$3230)) base))) (jolt-vector _o$3231 _o$3232))))))))) infer-call))) + (def-var! "jolt.passes.types" "infer-call" (letrec ((infer-call (lambda (node fnode iscall-var cn args n tenv env) (let fnrec3082 ((node node) (fnode fnode) (iscall-var iscall-var) (cn cn) (args args) (n n) (tenv tenv) (env env)) (let* ((fr (if (jolt-not iscall-var) (jolt-invoke (var-deref "jolt.passes.types" "infer") fnode tenv env) jolt-nil)) (fnode_PRIME_ (if (jolt-truthy? iscall-var) fnode (jolt-invoke (var-deref "jolt.passes.types" "nd") fr))) (callee-t (if (jolt-truthy? iscall-var) (let* ((_a$3083 (jolt-get env (keyword #f "vtypes"))) (_a$3084 (jolt-invoke (var-deref "jolt.passes.types" "var-key") fnode))) (jolt-get _a$3083 _a$3084)) (jolt-invoke (var-deref "jolt.passes.types" "ty") fr))) (ares (jolt-invoke (var-deref "clojure.core" "mapv") (lambda (a) (let fnrec3085 ((a a)) (jolt-invoke (var-deref "jolt.passes.types" "infer") a tenv env))) args))) (begin (if (jolt-truthy? iscall-var) (let* ((_a$3089 (var-deref "clojure.core" "swap!")) (_a$3090 (jolt-get env (keyword #f "calls"))) (_a$3091 jolt-conj) (_a$3092 (let* ((_o$3087 (jolt-invoke (var-deref "jolt.passes.types" "var-key") fnode)) (_o$3088 (jolt-invoke (var-deref "clojure.core" "mapv") (lambda (r) (let fnrec3086 ((r r)) (jolt-invoke (var-deref "jolt.passes.types" "ty") r))) ares))) (jolt-vector _o$3087 _o$3088)))) (jolt-invoke _a$3089 _a$3090 _a$3091 _a$3092)) jolt-nil) (if (jolt-truthy? (jolt-get env (keyword #f "checking?"))) (let* ((ats (jolt-invoke (var-deref "clojure.core" "mapv") (lambda (r) (let fnrec3093 ((r r)) (jolt-invoke (var-deref "jolt.passes.types" "ty") r))) ares)) (pos (jolt-get node (keyword #f "pos")))) (begin (if (jolt-truthy? cn) (jolt-invoke (var-deref "jolt.passes.types.check" "check-invoke") cn args ats pos env) jolt-nil) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.passes.types.check" "not-callable?") callee-t)) (let* ((_a$3102 (var-deref "clojure.core" "swap!")) (_a$3103 (jolt-get env (keyword #f "diags"))) (_a$3104 jolt-conj) (_a$3105 (let* ((_o$3094 (keyword #f "op")) (_o$3095 (keyword #f "call")) (_o$3096 (keyword #f "type")) (_o$3097 (jolt-invoke (var-deref "jolt.passes.types.check" "type-name") callee-t)) (_o$3098 (keyword #f "pos")) (_o$3099 pos) (_o$3100 (keyword #f "msg")) (_o$3101 (jolt-invoke (var-deref "clojure.core" "str") "cannot call " (jolt-invoke (var-deref "jolt.passes.types.check" "type-name") callee-t) " as a function"))) (jolt-hash-map _o$3094 _o$3095 _o$3096 _o$3097 _o$3098 _o$3099 _o$3100 _o$3101)))) (jolt-invoke _a$3102 _a$3103 _a$3104 _a$3105)) jolt-nil) (if (jolt-truthy? (let* ((and__13__auto (jolt-get env (keyword #f "strict?")))) (if (jolt-truthy? and__13__auto) iscall-var and__13__auto))) (let* ((k (jolt-invoke (var-deref "jolt.passes.types" "var-key") fnode)) (usig (jolt-get (jolt-invoke (var-deref "clojure.core" "deref") (jolt-get env (keyword #f "user-sigs"))) k))) (if (jolt-truthy? usig) (jolt-invoke (var-deref "jolt.passes.types" "check-user-call") k usig ats pos env) jolt-nil)) jolt-nil))) jolt-nil) (let* ((pm (let* ((and__13__auto iscall-var)) (if (jolt-truthy? and__13__auto) (let* ((_a$3106 (jolt-get env (keyword #f "protocol-methods"))) (_a$3107 (jolt-invoke (var-deref "jolt.passes.types" "var-key") fnode))) (jolt-get _a$3106 _a$3107)) and__13__auto))) (rtype (if (jolt-truthy? (let* ((and__13__auto pm)) (if (jolt-truthy? and__13__auto) (jolt-pos? n) and__13__auto))) (jolt-get (jolt-invoke (var-deref "jolt.passes.types" "ty") (jolt-nth ares 0)) (keyword #f "type")) jolt-nil)) (base (jolt-assoc node (keyword #f "fn") fnode_PRIME_ (keyword #f "args") (jolt-invoke (var-deref "clojure.core" "mapv") (lambda (r) (let fnrec3108 ((r r)) (jolt-invoke (var-deref "jolt.passes.types" "nd") r))) ares)))) (let* ((_o$3116 (if (jolt= cn "range") (jolt-invoke (var-deref "jolt.passes.types.lattice" "mk-vec") (keyword #f "num")) (if (jolt-truthy? (let* ((and__13__auto cn)) (if (jolt-truthy? and__13__auto) (let* ((and__13__auto (jolt-contains? (var-deref "jolt.passes.types" "elem-fns") cn))) (if (jolt-truthy? and__13__auto) (> n 0) and__13__auto)) and__13__auto))) (let* ((a0 (jolt-invoke (var-deref "jolt.passes.types" "ty") (jolt-nth ares 0)))) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.passes.types.lattice" "vec-type?") a0)) (jolt-invoke (var-deref "jolt.passes.types.lattice" "velem") a0) (keyword #f "any"))) (if (jolt-truthy? (keyword #f "else")) (jolt-invoke (var-deref "jolt.passes.types" "call-ret-type") fnode env) jolt-nil)))) (_o$3117 (if (jolt-truthy? rtype) (let* ((_a$3109 base) (_a$3110 (keyword #f "devirt-type")) (_a$3111 rtype) (_a$3112 (keyword #f "devirt-proto")) (_a$3113 (jolt-nth pm 0)) (_a$3114 (keyword #f "devirt-method")) (_a$3115 (jolt-nth pm 1))) (jolt-assoc _a$3109 _a$3110 _a$3111 _a$3112 _a$3113 _a$3114 _a$3115)) base))) (jolt-vector _o$3116 _o$3117))))))))) infer-call))) (guard (e (#t #f)) - (def-var! "jolt.passes.types" "infer-invoke" (letrec ((infer-invoke (lambda (node tenv env) (let fnrec3233 ((node node) (tenv tenv) (env env)) (let* ((fnode (jolt-get node (keyword #f "fn"))) (iscall-var (jolt= (keyword #f "var") (jolt-get fnode (keyword #f "op")))) (cn (if (jolt-truthy? (let* ((and__13__auto iscall-var)) (if (jolt-truthy? and__13__auto) (jolt= "clojure.core" (jolt-get fnode (keyword #f "ns"))) and__13__auto))) (jolt-get fnode (keyword #f "name")) jolt-nil)) (args (jolt-get node (keyword #f "args"))) (n (jolt-count args))) (if (jolt-truthy? (let* ((and__13__auto iscall-var)) (if (jolt-truthy? and__13__auto) (let* ((and__13__auto (jolt-contains? (var-deref "jolt.passes.types" "fold-preds") cn))) (if (jolt-truthy? and__13__auto) (jolt= n 1) and__13__auto)) and__13__auto))) (jolt-invoke (var-deref "jolt.passes.types" "infer-pred-fold") node fnode cn args tenv env) (if (jolt-truthy? (let* ((and__13__auto (jolt-invoke (var-deref "jolt.passes.fold" "kw-callee?") fnode))) (if (jolt-truthy? and__13__auto) (let* ((and__13__auto (>= n 1))) (if (jolt-truthy? and__13__auto) (<= n 2) and__13__auto)) and__13__auto))) (jolt-invoke (var-deref "jolt.passes.types" "infer-kw-lookup") node fnode args n tenv env) (if (jolt-truthy? (let* ((and__13__auto (jolt-invoke (var-deref "jolt.passes.fold" "get-callee?") fnode))) (if (jolt-truthy? and__13__auto) (let* ((and__13__auto (>= n 2))) (if (jolt-truthy? and__13__auto) (let* ((and__13__auto (jolt= (keyword #f "const") (jolt-get (jolt-nth args 1) (keyword #f "op"))))) (if (jolt-truthy? and__13__auto) (jolt-invoke (var-deref "clojure.core" "keyword?") (jolt-get (jolt-nth args 1) (keyword #f "val"))) and__13__auto)) and__13__auto)) and__13__auto))) (jolt-invoke (var-deref "jolt.passes.types" "infer-get-lookup") node args n tenv env) (if (jolt-truthy? (let* ((and__13__auto (jolt= cn "reduce"))) (if (jolt-truthy? and__13__auto) (let* ((and__13__auto (>= n 2))) (if (jolt-truthy? and__13__auto) (jolt= (keyword #f "fn") (jolt-get (jolt-nth args 0) (keyword #f "op"))) and__13__auto)) and__13__auto))) (jolt-invoke (var-deref "jolt.passes.types" "infer-reduce-hof") node args n tenv env) (if (jolt-truthy? (let* ((and__13__auto cn)) (if (jolt-truthy? and__13__auto) (let* ((and__13__auto (jolt-get (var-deref "jolt.passes.types" "hof-table") cn))) (if (jolt-truthy? and__13__auto) (let* ((and__13__auto (>= n 2))) (if (jolt-truthy? and__13__auto) (jolt= (keyword #f "fn") (jolt-get (jolt-nth args 0) (keyword #f "op"))) and__13__auto)) and__13__auto)) and__13__auto))) (jolt-invoke (var-deref "jolt.passes.types" "infer-seq-hof") node cn args tenv env) (if (jolt-truthy? (let* ((and__13__auto (let* ((or__14__auto (jolt= cn "conj"))) (if (jolt-truthy? or__14__auto) or__14__auto (jolt= cn "into"))))) (if (jolt-truthy? and__13__auto) (>= n 1) and__13__auto))) (jolt-invoke (var-deref "jolt.passes.types" "infer-conj-into") node fnode cn args n tenv env) (if (jolt-truthy? (keyword #f "else")) (jolt-invoke (var-deref "jolt.passes.types" "infer-call") node fnode iscall-var cn args n tenv env) jolt-nil)))))))))))) infer-invoke))) + (def-var! "jolt.passes.types" "infer-invoke" (letrec ((infer-invoke (lambda (node tenv env) (let fnrec3118 ((node node) (tenv tenv) (env env)) (let* ((fnode (jolt-get node (keyword #f "fn"))) (iscall-var (jolt= (keyword #f "var") (jolt-get fnode (keyword #f "op")))) (cn (if (jolt-truthy? (let* ((and__13__auto iscall-var)) (if (jolt-truthy? and__13__auto) (jolt= "clojure.core" (jolt-get fnode (keyword #f "ns"))) and__13__auto))) (jolt-get fnode (keyword #f "name")) jolt-nil)) (args (jolt-get node (keyword #f "args"))) (n (jolt-count args))) (if (jolt-truthy? (let* ((and__13__auto iscall-var)) (if (jolt-truthy? and__13__auto) (let* ((and__13__auto (jolt-contains? (var-deref "jolt.passes.types" "fold-preds") cn))) (if (jolt-truthy? and__13__auto) (jolt= n 1) and__13__auto)) and__13__auto))) (jolt-invoke (var-deref "jolt.passes.types" "infer-pred-fold") node fnode cn args tenv env) (if (jolt-truthy? (let* ((and__13__auto (jolt-invoke (var-deref "jolt.passes.fold" "kw-callee?") fnode))) (if (jolt-truthy? and__13__auto) (let* ((and__13__auto (>= n 1))) (if (jolt-truthy? and__13__auto) (<= n 2) and__13__auto)) and__13__auto))) (jolt-invoke (var-deref "jolt.passes.types" "infer-kw-lookup") node fnode args n tenv env) (if (jolt-truthy? (let* ((and__13__auto (jolt-invoke (var-deref "jolt.passes.fold" "get-callee?") fnode))) (if (jolt-truthy? and__13__auto) (let* ((and__13__auto (>= n 2))) (if (jolt-truthy? and__13__auto) (let* ((and__13__auto (jolt= (keyword #f "const") (jolt-get (jolt-nth args 1) (keyword #f "op"))))) (if (jolt-truthy? and__13__auto) (jolt-invoke (var-deref "clojure.core" "keyword?") (jolt-get (jolt-nth args 1) (keyword #f "val"))) and__13__auto)) and__13__auto)) and__13__auto))) (jolt-invoke (var-deref "jolt.passes.types" "infer-get-lookup") node args n tenv env) (if (jolt-truthy? (let* ((and__13__auto (jolt= cn "reduce"))) (if (jolt-truthy? and__13__auto) (let* ((and__13__auto (>= n 2))) (if (jolt-truthy? and__13__auto) (jolt= (keyword #f "fn") (jolt-get (jolt-nth args 0) (keyword #f "op"))) and__13__auto)) and__13__auto))) (jolt-invoke (var-deref "jolt.passes.types" "infer-reduce-hof") node args n tenv env) (if (jolt-truthy? (let* ((and__13__auto cn)) (if (jolt-truthy? and__13__auto) (let* ((and__13__auto (jolt-get (var-deref "jolt.passes.types" "hof-table") cn))) (if (jolt-truthy? and__13__auto) (let* ((and__13__auto (>= n 2))) (if (jolt-truthy? and__13__auto) (jolt= (keyword #f "fn") (jolt-get (jolt-nth args 0) (keyword #f "op"))) and__13__auto)) and__13__auto)) and__13__auto))) (jolt-invoke (var-deref "jolt.passes.types" "infer-seq-hof") node cn args tenv env) (if (jolt-truthy? (let* ((and__13__auto (let* ((or__14__auto (jolt= cn "conj"))) (if (jolt-truthy? or__14__auto) or__14__auto (jolt= cn "into"))))) (if (jolt-truthy? and__13__auto) (>= n 1) and__13__auto))) (jolt-invoke (var-deref "jolt.passes.types" "infer-conj-into") node fnode cn args n tenv env) (if (jolt-truthy? (keyword #f "else")) (jolt-invoke (var-deref "jolt.passes.types" "infer-call") node fnode iscall-var cn args n tenv env) jolt-nil)))))))))))) infer-invoke))) (guard (e (#t #f)) - (def-var! "jolt.passes.types" "infer" (letrec ((infer (lambda (node tenv env) (let fnrec3234 ((node node) (tenv tenv) (env env)) (let* ((op (jolt-get node (keyword #f "op")))) (if (jolt= op (keyword #f "const")) (let* ((_o$3235 (let* ((v (jolt-get node (keyword #f "val")))) (if (jolt-truthy? (jolt-invoke (var-deref "clojure.core" "number?") v)) (keyword #f "num") (if (jolt-truthy? (jolt-invoke (var-deref "clojure.core" "string?") v)) (keyword #f "str") (if (jolt-truthy? (jolt-invoke (var-deref "clojure.core" "keyword?") v)) (keyword #f "kw") (if (jolt-truthy? (let* ((or__14__auto (jolt-invoke (var-deref "clojure.core" "nil?") v))) (if (jolt-truthy? or__14__auto) or__14__auto (jolt= #f v)))) (keyword #f "any") (if (jolt-truthy? (keyword #f "else")) (keyword #f "truthy") jolt-nil))))))) (_o$3236 node)) (jolt-vector _o$3235 _o$3236)) (if (jolt= op (keyword #f "local")) (let* ((t (jolt-get tenv (jolt-get node (keyword #f "name"))))) (let* ((_o$3237 (if (jolt-truthy? t) t (keyword #f "any"))) (_o$3238 (if (jolt-truthy? (jolt-invoke (var-deref "jolt.passes.types.lattice" "struct-safe?") t)) (let* ((n (jolt-assoc node (keyword #f "hint") (keyword #f "struct")))) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.passes.types.lattice" "type-shape") t)) (jolt-assoc n (keyword #f "shape") (jolt-invoke (var-deref "jolt.passes.types.lattice" "type-shape") t)) n)) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.passes.types.lattice" "vec-type?") t)) (jolt-assoc node (keyword #f "hint") (keyword #f "vector")) (if (jolt-truthy? (keyword #f "else")) node jolt-nil))))) (jolt-vector _o$3237 _o$3238))) (if (jolt= op (keyword #f "map")) (let* ((pairs (jolt-get node (keyword #f "pairs"))) (res (jolt-invoke (var-deref "clojure.core" "mapv") (lambda (pr) (let fnrec3239 ((pr pr)) (let* ((kr (jolt-invoke infer (jolt-nth pr 0) tenv env)) (vr (jolt-invoke infer (jolt-nth pr 1) tenv env))) (let* ((_o$3240 (jolt-nth kr 1)) (_o$3241 (jolt-nth vr 1)) (_o$3242 (jolt-nth vr 0)) (_o$3243 (jolt-get (jolt-nth pr 0) (keyword #f "val")))) (jolt-vector _o$3240 _o$3241 _o$3242 _o$3243))))) pairs)) (struct? (let* ((and__13__auto (> (jolt-count res) 0))) (if (jolt-truthy? and__13__auto) (let* ((and__13__auto (jolt-invoke (var-deref "clojure.core" "every?") (lambda (pr) (let fnrec3244 ((pr pr)) (jolt-invoke (var-deref "jolt.passes.fold" "scalar-const?") (jolt-nth pr 0)))) pairs))) (if (jolt-truthy? and__13__auto) (jolt-invoke (var-deref "clojure.core" "every?") (lambda (r) (let fnrec3245 ((r r)) (jolt-invoke (var-deref "jolt.passes.types.lattice" "truthy-type?") (jolt-nth r 2)))) res) and__13__auto)) and__13__auto))) (base (if (jolt-truthy? struct?) (jolt-invoke (var-deref "jolt.passes.types.lattice" "cap") (jolt-invoke (var-deref "jolt.passes.types.lattice" "mk-struct") (let* ((_a$3250 (lambda (m r) (let fnrec3246 ((m m) (r r)) (let* ((_a$3247 m) (_a$3248 (jolt-nth r 3)) (_a$3249 (jolt-nth r 2))) (jolt-assoc _a$3247 _a$3248 _a$3249))))) (_a$3251 (jolt-hash-map)) (_a$3252 res)) (jolt-reduce _a$3250 _a$3251 _a$3252))) (var-deref "jolt.passes.types.lattice" "type-depth")) jolt-nil)) (shp (if (jolt-truthy? (let* ((and__13__auto (jolt-get env (keyword #f "map-shapes?")))) (if (jolt-truthy? and__13__auto) (let* ((and__13__auto base)) (if (jolt-truthy? and__13__auto) (jolt-invoke (var-deref "jolt.passes.types.lattice" "struct-type?") base) and__13__auto)) and__13__auto))) (jolt-invoke (var-deref "jolt.passes.types.lattice" "shape-order") (jolt-keys (jolt-invoke (var-deref "jolt.passes.types.lattice" "sfields") base))) jolt-nil)) (t (if (jolt-truthy? base) (if (jolt-truthy? shp) (jolt-assoc base (keyword #f "shape") shp) base) (keyword #f "any"))) (node_PRIME_ (jolt-assoc node (keyword #f "pairs") (jolt-invoke (var-deref "clojure.core" "mapv") (lambda (r) (let fnrec3253 ((r r)) (let* ((_o$3254 (jolt-nth r 0)) (_o$3255 (jolt-nth r 1))) (jolt-vector _o$3254 _o$3255)))) res)))) (let* ((_o$3256 t) (_o$3257 (if (jolt-truthy? shp) (jolt-assoc node_PRIME_ (keyword #f "shape") shp) node_PRIME_))) (jolt-vector _o$3256 _o$3257))) (if (jolt= op (keyword #f "vector")) (let* ((irs (let* ((_a$3259 (var-deref "clojure.core" "mapv")) (_a$3260 (lambda (x) (let fnrec3258 ((x x)) (jolt-invoke infer x tenv env)))) (_a$3261 (jolt-get node (keyword #f "items")))) (jolt-invoke _a$3259 _a$3260 _a$3261))) (ets (jolt-invoke (var-deref "clojure.core" "mapv") (lambda (r) (let fnrec3262 ((r r)) (jolt-nth r 0))) irs)) (el (if (jolt-empty? ets) (keyword #f "any") (let* ((_a$3263 (var-deref "jolt.passes.types.lattice" "join")) (_a$3264 (jolt-first ets)) (_a$3265 (jolt-rest ets))) (jolt-reduce _a$3263 _a$3264 _a$3265))))) (let* ((_o$3267 (jolt-invoke (var-deref "jolt.passes.types.lattice" "cap") (jolt-invoke (var-deref "jolt.passes.types.lattice" "mk-vec") el) (var-deref "jolt.passes.types.lattice" "type-depth"))) (_o$3268 (jolt-assoc node (keyword #f "items") (jolt-invoke (var-deref "clojure.core" "mapv") (lambda (r) (let fnrec3266 ((r r)) (jolt-nth r 1))) irs)))) (jolt-vector _o$3267 _o$3268))) (if (jolt= op (keyword #f "set")) (let* ((irs (let* ((_a$3270 (var-deref "clojure.core" "mapv")) (_a$3271 (lambda (x) (let fnrec3269 ((x x)) (jolt-invoke infer x tenv env)))) (_a$3272 (jolt-get node (keyword #f "items")))) (jolt-invoke _a$3270 _a$3271 _a$3272))) (ets (jolt-invoke (var-deref "clojure.core" "mapv") (lambda (r) (let fnrec3273 ((r r)) (jolt-nth r 0))) irs)) (el (if (jolt-empty? ets) (keyword #f "any") (let* ((_a$3274 (var-deref "jolt.passes.types.lattice" "join")) (_a$3275 (jolt-first ets)) (_a$3276 (jolt-rest ets))) (jolt-reduce _a$3274 _a$3275 _a$3276))))) (let* ((_o$3278 (jolt-invoke (var-deref "jolt.passes.types.lattice" "cap") (jolt-invoke (var-deref "jolt.passes.types.lattice" "mk-set") el) (var-deref "jolt.passes.types.lattice" "type-depth"))) (_o$3279 (jolt-assoc node (keyword #f "items") (jolt-invoke (var-deref "clojure.core" "mapv") (lambda (r) (let fnrec3277 ((r r)) (jolt-nth r 1))) irs)))) (jolt-vector _o$3278 _o$3279))) (if (jolt= op (keyword #f "if")) (let* ((tr (jolt-invoke infer (jolt-get node (keyword #f "test")) tenv env)) (thn (jolt-invoke infer (jolt-get node (keyword #f "then")) tenv env)) (els (jolt-invoke infer (jolt-get node (keyword #f "else")) tenv env))) (let* ((_o$3290 (let* ((_a$3280 (var-deref "jolt.passes.types.lattice" "join")) (_a$3281 (jolt-nth thn 0)) (_a$3282 (jolt-nth els 0))) (jolt-invoke _a$3280 _a$3281 _a$3282))) (_o$3291 (let* ((_a$3283 node) (_a$3284 (keyword #f "test")) (_a$3285 (jolt-nth tr 1)) (_a$3286 (keyword #f "then")) (_a$3287 (jolt-nth thn 1)) (_a$3288 (keyword #f "else")) (_a$3289 (jolt-nth els 1))) (jolt-assoc _a$3283 _a$3284 _a$3285 _a$3286 _a$3287 _a$3288 _a$3289)))) (jolt-vector _o$3290 _o$3291))) (if (jolt= op (keyword #f "do")) (let* ((stmts (let* ((_a$3293 (var-deref "clojure.core" "mapv")) (_a$3294 (lambda (s) (let fnrec3292 ((s s)) (jolt-nth (jolt-invoke infer s tenv env) 1)))) (_a$3295 (jolt-get node (keyword #f "statements")))) (jolt-invoke _a$3293 _a$3294 _a$3295))) (r (jolt-invoke infer (jolt-get node (keyword #f "ret")) tenv env))) (let* ((_o$3296 (jolt-nth r 0)) (_o$3297 (jolt-assoc node (keyword #f "statements") stmts (keyword #f "ret") (jolt-nth r 1)))) (jolt-vector _o$3296 _o$3297))) (if (jolt= op (keyword #f "throw")) (let* ((_o$3298 (keyword #f "any")) (_o$3299 (jolt-assoc node (keyword #f "expr") (jolt-nth (jolt-invoke infer (jolt-get node (keyword #f "expr")) tenv env) 1)))) (jolt-vector _o$3298 _o$3299)) (if (jolt= op (keyword #f "var")) (begin (let* ((_a$3300 (var-deref "clojure.core" "swap!")) (_a$3301 (jolt-get env (keyword #f "escapes"))) (_a$3302 jolt-conj) (_a$3303 (jolt-invoke (var-deref "jolt.passes.types" "var-key") node))) (jolt-invoke _a$3300 _a$3301 _a$3302 _a$3303)) (let* ((_o$3306 (let* ((vt (let* ((_a$3304 (jolt-get env (keyword #f "vtypes"))) (_a$3305 (jolt-invoke (var-deref "jolt.passes.types" "var-key") node))) (jolt-get _a$3304 _a$3305)))) (if (jolt-truthy? vt) vt (keyword #f "any")))) (_o$3307 node)) (jolt-vector _o$3306 _o$3307))) (if (jolt= op (keyword #f "invoke")) (jolt-invoke (var-deref "jolt.passes.types" "infer-invoke") node tenv env) (if (jolt= op (keyword #f "let")) (let* ((res (let* ((_a$3318 (lambda (acc b) (let fnrec3308 ((acc acc) (b b)) (let* ((te (jolt-nth acc 0)) (binds (jolt-nth acc 1)) (ir (jolt-invoke infer (jolt-nth b 1) te env))) (let* ((_o$3314 (let* ((_a$3309 te) (_a$3310 (jolt-nth b 0)) (_a$3311 (jolt-nth ir 0))) (jolt-assoc _a$3309 _a$3310 _a$3311))) (_o$3315 (jolt-conj binds (let* ((_o$3312 (jolt-nth b 0)) (_o$3313 (jolt-nth ir 1))) (jolt-vector _o$3312 _o$3313))))) (jolt-vector _o$3314 _o$3315)))))) (_a$3319 (let* ((_o$3316 tenv) (_o$3317 (jolt-vector))) (jolt-vector _o$3316 _o$3317))) (_a$3320 (jolt-get node (keyword #f "bindings")))) (jolt-reduce _a$3318 _a$3319 _a$3320))) (br (let* ((_a$3321 infer) (_a$3322 (jolt-get node (keyword #f "body"))) (_a$3323 (jolt-nth res 0)) (_a$3324 env)) (jolt-invoke _a$3321 _a$3322 _a$3323 _a$3324)))) (let* ((_o$3330 (jolt-nth br 0)) (_o$3331 (let* ((_a$3325 node) (_a$3326 (keyword #f "bindings")) (_a$3327 (jolt-nth res 1)) (_a$3328 (keyword #f "body")) (_a$3329 (jolt-nth br 1))) (jolt-assoc _a$3325 _a$3326 _a$3327 _a$3328 _a$3329)))) (jolt-vector _o$3330 _o$3331))) (if (jolt= op (keyword #f "loop")) (let* ((_o$3343 (keyword #f "any")) (_o$3344 (let* ((_a$3338 node) (_a$3339 (keyword #f "bindings")) (_a$3340 (let* ((_a$3335 (var-deref "clojure.core" "mapv")) (_a$3336 (lambda (b) (let fnrec3332 ((b b)) (let* ((_o$3333 (jolt-nth b 0)) (_o$3334 (jolt-nth (jolt-invoke infer (jolt-nth b 1) tenv env) 1))) (jolt-vector _o$3333 _o$3334))))) (_a$3337 (jolt-get node (keyword #f "bindings")))) (jolt-invoke _a$3335 _a$3336 _a$3337))) (_a$3341 (keyword #f "body")) (_a$3342 (jolt-nth (jolt-invoke infer (jolt-get node (keyword #f "body")) tenv env) 1))) (jolt-assoc _a$3338 _a$3339 _a$3340 _a$3341 _a$3342)))) (jolt-vector _o$3343 _o$3344)) (if (jolt= op (keyword #f "recur")) (let* ((_o$3349 (keyword #f "any")) (_o$3350 (jolt-assoc node (keyword #f "args") (let* ((_a$3346 (var-deref "clojure.core" "mapv")) (_a$3347 (lambda (a) (let fnrec3345 ((a a)) (jolt-nth (jolt-invoke infer a tenv env) 1)))) (_a$3348 (jolt-get node (keyword #f "args")))) (jolt-invoke _a$3346 _a$3347 _a$3348))))) (jolt-vector _o$3349 _o$3350)) (if (jolt= op (keyword #f "fn")) (let* ((_o$3366 (keyword #f "any")) (_o$3367 (jolt-assoc node (keyword #f "arities") (let* ((_a$3363 (var-deref "clojure.core" "mapv")) (_a$3364 (lambda (a) (let fnrec3351 ((a a)) (let* ((shapes (jolt-get env (keyword #f "record-shapes"))) (phm (let* ((_a$3356 (lambda (m pr) (let fnrec3352 ((m m) (pr pr)) (let* ((_a$3353 m) (_a$3354 (jolt-nth pr 0)) (_a$3355 (jolt-nth pr 1))) (jolt-assoc _a$3353 _a$3354 _a$3355))))) (_a$3357 (jolt-hash-map)) (_a$3358 (jolt-get a (keyword #f "phints")))) (jolt-reduce _a$3356 _a$3357 _a$3358))) (pe (let* ((_a$3360 (lambda (e p) (let fnrec3359 ((e e) (p p)) (jolt-assoc e p (let* ((ent (jolt-get shapes (jolt-get phm p)))) (if (jolt-truthy? ent) (jolt-invoke (var-deref "jolt.passes.types" "record-type-from-entry") ent (var-deref "jolt.passes.types.lattice" "type-depth") shapes) (keyword #f "any"))))))) (_a$3361 tenv) (_a$3362 (jolt-get a (keyword #f "params")))) (jolt-reduce _a$3360 _a$3361 _a$3362))) (pe (if (jolt-truthy? (jolt-get a (keyword #f "rest"))) (jolt-assoc pe (jolt-get a (keyword #f "rest")) (keyword #f "any")) pe))) (jolt-assoc a (keyword #f "body") (jolt-nth (jolt-invoke infer (jolt-get a (keyword #f "body")) pe env) 1)))))) (_a$3365 (jolt-get node (keyword #f "arities")))) (jolt-invoke _a$3363 _a$3364 _a$3365))))) (jolt-vector _o$3366 _o$3367)) (if (jolt= op (keyword #f "def")) (begin (if (jolt-truthy? (jolt-get env (keyword #f "checking?"))) (jolt-invoke (var-deref "jolt.passes.types" "register-user-fn!") node env) jolt-nil) (let* ((_o$3368 (keyword #f "any")) (_o$3369 (jolt-assoc node (keyword #f "init") (jolt-nth (jolt-invoke infer (jolt-get node (keyword #f "init")) tenv env) 1)))) (jolt-vector _o$3368 _o$3369))) (if (jolt= op (keyword #f "try")) (let* ((_o$3377 (keyword #f "any")) (_o$3378 (let* ((_a$3370 node) (_a$3371 (keyword #f "body")) (_a$3372 (jolt-nth (jolt-invoke infer (jolt-get node (keyword #f "body")) tenv env) 1)) (_a$3373 (keyword #f "catch-body")) (_a$3374 (if (jolt-truthy? (jolt-get node (keyword #f "catch-body"))) (jolt-nth (jolt-invoke infer (jolt-get node (keyword #f "catch-body")) tenv env) 1) jolt-nil)) (_a$3375 (keyword #f "finally")) (_a$3376 (if (jolt-truthy? (jolt-get node (keyword #f "finally"))) (jolt-nth (jolt-invoke infer (jolt-get node (keyword #f "finally")) tenv env) 1) jolt-nil))) (jolt-assoc _a$3370 _a$3371 _a$3372 _a$3373 _a$3374 _a$3375 _a$3376)))) (jolt-vector _o$3377 _o$3378)) (if (jolt-truthy? (keyword #f "else")) (let* ((_o$3379 (keyword #f "any")) (_o$3380 node)) (jolt-vector _o$3379 _o$3380)) jolt-nil)))))))))))))))))))))) infer))) + (def-var! "jolt.passes.types" "infer" (letrec ((infer (lambda (node tenv env) (let fnrec3119 ((node node) (tenv tenv) (env env)) (let* ((op (jolt-get node (keyword #f "op")))) (if (jolt= op (keyword #f "const")) (let* ((_o$3120 (let* ((v (jolt-get node (keyword #f "val")))) (if (jolt-truthy? (jolt-invoke (var-deref "clojure.core" "number?") v)) (keyword #f "num") (if (jolt-truthy? (jolt-invoke (var-deref "clojure.core" "string?") v)) (keyword #f "str") (if (jolt-truthy? (jolt-invoke (var-deref "clojure.core" "keyword?") v)) (keyword #f "kw") (if (jolt-truthy? (let* ((or__14__auto (jolt-invoke (var-deref "clojure.core" "nil?") v))) (if (jolt-truthy? or__14__auto) or__14__auto (jolt= #f v)))) (keyword #f "any") (if (jolt-truthy? (keyword #f "else")) (keyword #f "truthy") jolt-nil))))))) (_o$3121 node)) (jolt-vector _o$3120 _o$3121)) (if (jolt= op (keyword #f "local")) (let* ((t (jolt-get tenv (jolt-get node (keyword #f "name"))))) (let* ((_o$3122 (if (jolt-truthy? t) t (keyword #f "any"))) (_o$3123 (if (jolt-truthy? (jolt-invoke (var-deref "jolt.passes.types.lattice" "struct-safe?") t)) (let* ((n (jolt-assoc node (keyword #f "hint") (keyword #f "struct")))) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.passes.types.lattice" "type-shape") t)) (jolt-assoc n (keyword #f "shape") (jolt-invoke (var-deref "jolt.passes.types.lattice" "type-shape") t)) n)) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.passes.types.lattice" "vec-type?") t)) (jolt-assoc node (keyword #f "hint") (keyword #f "vector")) (if (jolt-truthy? (keyword #f "else")) node jolt-nil))))) (jolt-vector _o$3122 _o$3123))) (if (jolt= op (keyword #f "map")) (let* ((pairs (jolt-get node (keyword #f "pairs"))) (res (jolt-invoke (var-deref "clojure.core" "mapv") (lambda (pr) (let fnrec3124 ((pr pr)) (let* ((kr (jolt-invoke infer (jolt-nth pr 0) tenv env)) (vr (jolt-invoke infer (jolt-nth pr 1) tenv env))) (let* ((_o$3125 (jolt-nth kr 1)) (_o$3126 (jolt-nth vr 1)) (_o$3127 (jolt-nth vr 0)) (_o$3128 (jolt-get (jolt-nth pr 0) (keyword #f "val")))) (jolt-vector _o$3125 _o$3126 _o$3127 _o$3128))))) pairs)) (struct? (let* ((and__13__auto (> (jolt-count res) 0))) (if (jolt-truthy? and__13__auto) (let* ((and__13__auto (jolt-invoke (var-deref "clojure.core" "every?") (lambda (pr) (let fnrec3129 ((pr pr)) (jolt-invoke (var-deref "jolt.passes.fold" "scalar-const?") (jolt-nth pr 0)))) pairs))) (if (jolt-truthy? and__13__auto) (jolt-invoke (var-deref "clojure.core" "every?") (lambda (r) (let fnrec3130 ((r r)) (jolt-invoke (var-deref "jolt.passes.types.lattice" "truthy-type?") (jolt-nth r 2)))) res) and__13__auto)) and__13__auto))) (base (if (jolt-truthy? struct?) (jolt-invoke (var-deref "jolt.passes.types.lattice" "cap") (jolt-invoke (var-deref "jolt.passes.types.lattice" "mk-struct") (let* ((_a$3135 (lambda (m r) (let fnrec3131 ((m m) (r r)) (let* ((_a$3132 m) (_a$3133 (jolt-nth r 3)) (_a$3134 (jolt-nth r 2))) (jolt-assoc _a$3132 _a$3133 _a$3134))))) (_a$3136 (jolt-hash-map)) (_a$3137 res)) (jolt-reduce _a$3135 _a$3136 _a$3137))) (var-deref "jolt.passes.types.lattice" "type-depth")) jolt-nil)) (shp (if (jolt-truthy? (let* ((and__13__auto (jolt-get env (keyword #f "map-shapes?")))) (if (jolt-truthy? and__13__auto) (let* ((and__13__auto base)) (if (jolt-truthy? and__13__auto) (jolt-invoke (var-deref "jolt.passes.types.lattice" "struct-type?") base) and__13__auto)) and__13__auto))) (jolt-invoke (var-deref "jolt.passes.types.lattice" "shape-order") (jolt-keys (jolt-invoke (var-deref "jolt.passes.types.lattice" "sfields") base))) jolt-nil)) (t (if (jolt-truthy? base) (if (jolt-truthy? shp) (jolt-assoc base (keyword #f "shape") shp) base) (keyword #f "any"))) (node_PRIME_ (jolt-assoc node (keyword #f "pairs") (jolt-invoke (var-deref "clojure.core" "mapv") (lambda (r) (let fnrec3138 ((r r)) (let* ((_o$3139 (jolt-nth r 0)) (_o$3140 (jolt-nth r 1))) (jolt-vector _o$3139 _o$3140)))) res)))) (let* ((_o$3141 t) (_o$3142 (if (jolt-truthy? shp) (jolt-assoc node_PRIME_ (keyword #f "shape") shp) node_PRIME_))) (jolt-vector _o$3141 _o$3142))) (if (jolt= op (keyword #f "vector")) (let* ((irs (let* ((_a$3144 (var-deref "clojure.core" "mapv")) (_a$3145 (lambda (x) (let fnrec3143 ((x x)) (jolt-invoke infer x tenv env)))) (_a$3146 (jolt-get node (keyword #f "items")))) (jolt-invoke _a$3144 _a$3145 _a$3146))) (ets (jolt-invoke (var-deref "clojure.core" "mapv") (lambda (r) (let fnrec3147 ((r r)) (jolt-nth r 0))) irs)) (el (if (jolt-empty? ets) (keyword #f "any") (let* ((_a$3148 (var-deref "jolt.passes.types.lattice" "join")) (_a$3149 (jolt-first ets)) (_a$3150 (jolt-rest ets))) (jolt-reduce _a$3148 _a$3149 _a$3150))))) (let* ((_o$3152 (jolt-invoke (var-deref "jolt.passes.types.lattice" "cap") (jolt-invoke (var-deref "jolt.passes.types.lattice" "mk-vec") el) (var-deref "jolt.passes.types.lattice" "type-depth"))) (_o$3153 (jolt-assoc node (keyword #f "items") (jolt-invoke (var-deref "clojure.core" "mapv") (lambda (r) (let fnrec3151 ((r r)) (jolt-nth r 1))) irs)))) (jolt-vector _o$3152 _o$3153))) (if (jolt= op (keyword #f "set")) (let* ((irs (let* ((_a$3155 (var-deref "clojure.core" "mapv")) (_a$3156 (lambda (x) (let fnrec3154 ((x x)) (jolt-invoke infer x tenv env)))) (_a$3157 (jolt-get node (keyword #f "items")))) (jolt-invoke _a$3155 _a$3156 _a$3157))) (ets (jolt-invoke (var-deref "clojure.core" "mapv") (lambda (r) (let fnrec3158 ((r r)) (jolt-nth r 0))) irs)) (el (if (jolt-empty? ets) (keyword #f "any") (let* ((_a$3159 (var-deref "jolt.passes.types.lattice" "join")) (_a$3160 (jolt-first ets)) (_a$3161 (jolt-rest ets))) (jolt-reduce _a$3159 _a$3160 _a$3161))))) (let* ((_o$3163 (jolt-invoke (var-deref "jolt.passes.types.lattice" "cap") (jolt-invoke (var-deref "jolt.passes.types.lattice" "mk-set") el) (var-deref "jolt.passes.types.lattice" "type-depth"))) (_o$3164 (jolt-assoc node (keyword #f "items") (jolt-invoke (var-deref "clojure.core" "mapv") (lambda (r) (let fnrec3162 ((r r)) (jolt-nth r 1))) irs)))) (jolt-vector _o$3163 _o$3164))) (if (jolt= op (keyword #f "if")) (let* ((tr (jolt-invoke infer (jolt-get node (keyword #f "test")) tenv env)) (thn (jolt-invoke infer (jolt-get node (keyword #f "then")) tenv env)) (els (jolt-invoke infer (jolt-get node (keyword #f "else")) tenv env))) (let* ((_o$3175 (let* ((_a$3165 (var-deref "jolt.passes.types.lattice" "join")) (_a$3166 (jolt-nth thn 0)) (_a$3167 (jolt-nth els 0))) (jolt-invoke _a$3165 _a$3166 _a$3167))) (_o$3176 (let* ((_a$3168 node) (_a$3169 (keyword #f "test")) (_a$3170 (jolt-nth tr 1)) (_a$3171 (keyword #f "then")) (_a$3172 (jolt-nth thn 1)) (_a$3173 (keyword #f "else")) (_a$3174 (jolt-nth els 1))) (jolt-assoc _a$3168 _a$3169 _a$3170 _a$3171 _a$3172 _a$3173 _a$3174)))) (jolt-vector _o$3175 _o$3176))) (if (jolt= op (keyword #f "do")) (let* ((stmts (let* ((_a$3178 (var-deref "clojure.core" "mapv")) (_a$3179 (lambda (s) (let fnrec3177 ((s s)) (jolt-nth (jolt-invoke infer s tenv env) 1)))) (_a$3180 (jolt-get node (keyword #f "statements")))) (jolt-invoke _a$3178 _a$3179 _a$3180))) (r (jolt-invoke infer (jolt-get node (keyword #f "ret")) tenv env))) (let* ((_o$3181 (jolt-nth r 0)) (_o$3182 (jolt-assoc node (keyword #f "statements") stmts (keyword #f "ret") (jolt-nth r 1)))) (jolt-vector _o$3181 _o$3182))) (if (jolt= op (keyword #f "throw")) (let* ((_o$3183 (keyword #f "any")) (_o$3184 (jolt-assoc node (keyword #f "expr") (jolt-nth (jolt-invoke infer (jolt-get node (keyword #f "expr")) tenv env) 1)))) (jolt-vector _o$3183 _o$3184)) (if (jolt= op (keyword #f "var")) (begin (let* ((_a$3185 (var-deref "clojure.core" "swap!")) (_a$3186 (jolt-get env (keyword #f "escapes"))) (_a$3187 jolt-conj) (_a$3188 (jolt-invoke (var-deref "jolt.passes.types" "var-key") node))) (jolt-invoke _a$3185 _a$3186 _a$3187 _a$3188)) (let* ((_o$3191 (let* ((vt (let* ((_a$3189 (jolt-get env (keyword #f "vtypes"))) (_a$3190 (jolt-invoke (var-deref "jolt.passes.types" "var-key") node))) (jolt-get _a$3189 _a$3190)))) (if (jolt-truthy? vt) vt (keyword #f "any")))) (_o$3192 node)) (jolt-vector _o$3191 _o$3192))) (if (jolt= op (keyword #f "invoke")) (jolt-invoke (var-deref "jolt.passes.types" "infer-invoke") node tenv env) (if (jolt= op (keyword #f "let")) (let* ((res (let* ((_a$3203 (lambda (acc b) (let fnrec3193 ((acc acc) (b b)) (let* ((te (jolt-nth acc 0)) (binds (jolt-nth acc 1)) (ir (jolt-invoke infer (jolt-nth b 1) te env))) (let* ((_o$3199 (let* ((_a$3194 te) (_a$3195 (jolt-nth b 0)) (_a$3196 (jolt-nth ir 0))) (jolt-assoc _a$3194 _a$3195 _a$3196))) (_o$3200 (jolt-conj binds (let* ((_o$3197 (jolt-nth b 0)) (_o$3198 (jolt-nth ir 1))) (jolt-vector _o$3197 _o$3198))))) (jolt-vector _o$3199 _o$3200)))))) (_a$3204 (let* ((_o$3201 tenv) (_o$3202 (jolt-vector))) (jolt-vector _o$3201 _o$3202))) (_a$3205 (jolt-get node (keyword #f "bindings")))) (jolt-reduce _a$3203 _a$3204 _a$3205))) (br (let* ((_a$3206 infer) (_a$3207 (jolt-get node (keyword #f "body"))) (_a$3208 (jolt-nth res 0)) (_a$3209 env)) (jolt-invoke _a$3206 _a$3207 _a$3208 _a$3209)))) (let* ((_o$3215 (jolt-nth br 0)) (_o$3216 (let* ((_a$3210 node) (_a$3211 (keyword #f "bindings")) (_a$3212 (jolt-nth res 1)) (_a$3213 (keyword #f "body")) (_a$3214 (jolt-nth br 1))) (jolt-assoc _a$3210 _a$3211 _a$3212 _a$3213 _a$3214)))) (jolt-vector _o$3215 _o$3216))) (if (jolt= op (keyword #f "loop")) (let* ((_o$3228 (keyword #f "any")) (_o$3229 (let* ((_a$3223 node) (_a$3224 (keyword #f "bindings")) (_a$3225 (let* ((_a$3220 (var-deref "clojure.core" "mapv")) (_a$3221 (lambda (b) (let fnrec3217 ((b b)) (let* ((_o$3218 (jolt-nth b 0)) (_o$3219 (jolt-nth (jolt-invoke infer (jolt-nth b 1) tenv env) 1))) (jolt-vector _o$3218 _o$3219))))) (_a$3222 (jolt-get node (keyword #f "bindings")))) (jolt-invoke _a$3220 _a$3221 _a$3222))) (_a$3226 (keyword #f "body")) (_a$3227 (jolt-nth (jolt-invoke infer (jolt-get node (keyword #f "body")) tenv env) 1))) (jolt-assoc _a$3223 _a$3224 _a$3225 _a$3226 _a$3227)))) (jolt-vector _o$3228 _o$3229)) (if (jolt= op (keyword #f "recur")) (let* ((_o$3234 (keyword #f "any")) (_o$3235 (jolt-assoc node (keyword #f "args") (let* ((_a$3231 (var-deref "clojure.core" "mapv")) (_a$3232 (lambda (a) (let fnrec3230 ((a a)) (jolt-nth (jolt-invoke infer a tenv env) 1)))) (_a$3233 (jolt-get node (keyword #f "args")))) (jolt-invoke _a$3231 _a$3232 _a$3233))))) (jolt-vector _o$3234 _o$3235)) (if (jolt= op (keyword #f "fn")) (let* ((_o$3251 (keyword #f "any")) (_o$3252 (jolt-assoc node (keyword #f "arities") (let* ((_a$3248 (var-deref "clojure.core" "mapv")) (_a$3249 (lambda (a) (let fnrec3236 ((a a)) (let* ((shapes (jolt-get env (keyword #f "record-shapes"))) (phm (let* ((_a$3241 (lambda (m pr) (let fnrec3237 ((m m) (pr pr)) (let* ((_a$3238 m) (_a$3239 (jolt-nth pr 0)) (_a$3240 (jolt-nth pr 1))) (jolt-assoc _a$3238 _a$3239 _a$3240))))) (_a$3242 (jolt-hash-map)) (_a$3243 (jolt-get a (keyword #f "phints")))) (jolt-reduce _a$3241 _a$3242 _a$3243))) (pe (let* ((_a$3245 (lambda (e p) (let fnrec3244 ((e e) (p p)) (jolt-assoc e p (let* ((ent (jolt-get shapes (jolt-get phm p)))) (if (jolt-truthy? ent) (jolt-invoke (var-deref "jolt.passes.types" "record-type-from-entry") ent (var-deref "jolt.passes.types.lattice" "type-depth") shapes) (keyword #f "any"))))))) (_a$3246 tenv) (_a$3247 (jolt-get a (keyword #f "params")))) (jolt-reduce _a$3245 _a$3246 _a$3247))) (pe (if (jolt-truthy? (jolt-get a (keyword #f "rest"))) (jolt-assoc pe (jolt-get a (keyword #f "rest")) (keyword #f "any")) pe))) (jolt-assoc a (keyword #f "body") (jolt-nth (jolt-invoke infer (jolt-get a (keyword #f "body")) pe env) 1)))))) (_a$3250 (jolt-get node (keyword #f "arities")))) (jolt-invoke _a$3248 _a$3249 _a$3250))))) (jolt-vector _o$3251 _o$3252)) (if (jolt= op (keyword #f "def")) (begin (if (jolt-truthy? (jolt-get env (keyword #f "checking?"))) (jolt-invoke (var-deref "jolt.passes.types.check" "register-user-fn!") node env) jolt-nil) (let* ((_o$3253 (keyword #f "any")) (_o$3254 (jolt-assoc node (keyword #f "init") (jolt-nth (jolt-invoke infer (jolt-get node (keyword #f "init")) tenv env) 1)))) (jolt-vector _o$3253 _o$3254))) (if (jolt= op (keyword #f "try")) (let* ((_o$3262 (keyword #f "any")) (_o$3263 (let* ((_a$3255 node) (_a$3256 (keyword #f "body")) (_a$3257 (jolt-nth (jolt-invoke infer (jolt-get node (keyword #f "body")) tenv env) 1)) (_a$3258 (keyword #f "catch-body")) (_a$3259 (if (jolt-truthy? (jolt-get node (keyword #f "catch-body"))) (jolt-nth (jolt-invoke infer (jolt-get node (keyword #f "catch-body")) tenv env) 1) jolt-nil)) (_a$3260 (keyword #f "finally")) (_a$3261 (if (jolt-truthy? (jolt-get node (keyword #f "finally"))) (jolt-nth (jolt-invoke infer (jolt-get node (keyword #f "finally")) tenv env) 1) jolt-nil))) (jolt-assoc _a$3255 _a$3256 _a$3257 _a$3258 _a$3259 _a$3260 _a$3261)))) (jolt-vector _o$3262 _o$3263)) (if (jolt-truthy? (keyword #f "else")) (let* ((_o$3264 (keyword #f "any")) (_o$3265 node)) (jolt-vector _o$3264 _o$3265)) jolt-nil)))))))))))))))))))))) infer))) (guard (e (#t #f)) - (def-var! "jolt.passes.types" "infer-top" (letrec ((infer-top (lambda (node env) (let fnrec3381 ((node node) (env env)) (jolt-nth (jolt-invoke (var-deref "jolt.passes.types" "infer") node (jolt-hash-map) env) 1))))) infer-top))) + (def-var! "jolt.passes.types" "infer-top" (letrec ((infer-top (lambda (node env) (let fnrec3266 ((node node) (env env)) (jolt-nth (jolt-invoke (var-deref "jolt.passes.types" "infer") node (jolt-hash-map) env) 1))))) infer-top))) (guard (e (#t #f)) - (def-var! "jolt.passes.types" "not-number?" (letrec ((not-number? (lambda (t) (let fnrec3382 ((t t)) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.passes.types.lattice" "union-type?") t)) (jolt-invoke (var-deref "clojure.core" "every?") not-number? (jolt-invoke (var-deref "jolt.passes.types.lattice" "umembers") t)) (let* ((or__14__auto (jolt= t (keyword #f "str")))) (if (jolt-truthy? or__14__auto) or__14__auto (let* ((or__14__auto (jolt= t (keyword #f "kw")))) (if (jolt-truthy? or__14__auto) or__14__auto (let* ((or__14__auto (jolt= t (keyword #f "phm")))) (if (jolt-truthy? or__14__auto) or__14__auto (let* ((or__14__auto (jolt-invoke (var-deref "jolt.passes.types.lattice" "struct-type?") t))) (if (jolt-truthy? or__14__auto) or__14__auto (let* ((or__14__auto (jolt-invoke (var-deref "jolt.passes.types.lattice" "vec-type?") t))) (if (jolt-truthy? or__14__auto) or__14__auto (jolt-invoke (var-deref "jolt.passes.types.lattice" "set-type?") t)))))))))))))))) not-number?))) + (def-var! "jolt.passes.types" "all-any-env" (letrec ((all-any-env (lambda (params) (let fnrec3267 ((params params)) (let* ((_a$3269 (lambda (e p) (let fnrec3268 ((e e) (p p)) (jolt-assoc e p (keyword #f "any"))))) (_a$3270 (jolt-hash-map)) (_a$3271 params)) (jolt-reduce _a$3269 _a$3270 _a$3271)))))) all-any-env))) (guard (e (#t #f)) - (def-var! "jolt.passes.types" "not-seqable?" (letrec ((not-seqable? (lambda (t) (let fnrec3383 ((t t)) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.passes.types.lattice" "union-type?") t)) (jolt-invoke (var-deref "clojure.core" "every?") not-seqable? (jolt-invoke (var-deref "jolt.passes.types.lattice" "umembers") t)) (let* ((or__14__auto (jolt= t (keyword #f "num")))) (if (jolt-truthy? or__14__auto) or__14__auto (jolt= t (keyword #f "kw"))))))))) not-seqable?))) + (def-var! "jolt.passes.types" "isolated-diag-count" (letrec ((isolated-diag-count (lambda (body tenv env) (let fnrec3272 ((body body) (tenv tenv) (env env)) (let* ((sub (jolt-assoc env (keyword #f "diags") (jolt-invoke (var-deref "clojure.core" "atom") (jolt-vector))))) (begin (jolt-invoke (var-deref "jolt.passes.types" "infer") body tenv sub) (jolt-count (jolt-invoke (var-deref "clojure.core" "deref") (jolt-get sub (keyword #f "diags")))))))))) isolated-diag-count))) (guard (e (#t #f)) - (def-var! "jolt.passes.types" "not-callable?" (letrec ((not-callable? (lambda (t) (let fnrec3384 ((t t)) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.passes.types.lattice" "union-type?") t)) (jolt-invoke (var-deref "clojure.core" "every?") not-callable? (jolt-invoke (var-deref "jolt.passes.types.lattice" "umembers") t)) (let* ((or__14__auto (jolt= t (keyword #f "num")))) (if (jolt-truthy? or__14__auto) or__14__auto (jolt= t (keyword #f "str"))))))))) not-callable?))) + (def-var! "jolt.passes.types" "check-user-call" (letrec ((check-user-call (lambda (key sig arg-types pos env) (let fnrec3273 ((key key) (sig sig) (arg-types arg-types) (pos pos) (env env)) (let* ((cset (jolt-get env (keyword #f "checking-set")))) (if (jolt-not (jolt-contains? (jolt-invoke (var-deref "clojure.core" "deref") cset) key)) (let* ((prev (jolt-invoke (var-deref "clojure.core" "deref") cset))) (begin (jolt-invoke (var-deref "clojure.core" "reset!") cset (jolt-conj prev key)) (let* ((params (jolt-get sig (keyword #f "params"))) (body (jolt-get sig (keyword #f "body"))) (npar (jolt-count params)) (nargs (jolt-count arg-types)) (memo (jolt-get env (keyword #f "diag-memo")))) (if (jolt-truthy? (jolt-invoke (var-deref "clojure.core" "not=") npar nargs)) (let* ((_a$3282 (var-deref "clojure.core" "swap!")) (_a$3283 (jolt-get env (keyword #f "diags"))) (_a$3284 jolt-conj) (_a$3285 (let* ((_o$3274 (keyword #f "op")) (_o$3275 (keyword #f "user-call")) (_o$3276 (keyword #f "type")) (_o$3277 (keyword #f "arity")) (_o$3278 (keyword #f "pos")) (_o$3279 pos) (_o$3280 (keyword #f "msg")) (_o$3281 (jolt-invoke (var-deref "clojure.core" "str") "wrong number of args (" nargs ") passed to `" (jolt-get sig (keyword #f "name")) "` (expected " npar ")"))) (jolt-hash-map _o$3274 _o$3275 _o$3276 _o$3277 _o$3278 _o$3279 _o$3280 _o$3281)))) (jolt-invoke _a$3282 _a$3283 _a$3284 _a$3285)) (let* ((base-env (jolt-invoke (var-deref "jolt.passes.types" "all-any-env") params)) (base (let* ((bk (let* ((_o$3286 (keyword #f "base")) (_o$3287 key)) (jolt-vector _o$3286 _o$3287)))) (if (jolt-contains? (jolt-invoke (var-deref "clojure.core" "deref") memo) bk) (jolt-get (jolt-invoke (var-deref "clojure.core" "deref") memo) bk) (let* ((b (jolt-invoke (var-deref "jolt.passes.types" "isolated-diag-count") body base-env env))) (begin (jolt-invoke (var-deref "clojure.core" "swap!") memo jolt-assoc bk b) b)))))) (let* ((_a$3315 (lambda (_ i) (let fnrec3288 ((_ _) (i i)) (begin (let* ((at (jolt-nth arg-types i))) (if (jolt-truthy? (let* ((and__13__auto (jolt-invoke (var-deref "clojure.core" "not=") at (keyword #f "any")))) (if (jolt-truthy? and__13__auto) (jolt-invoke (var-deref "clojure.core" "not=") at (keyword #f "truthy")) and__13__auto))) (let* ((mk (let* ((_o$3289 (keyword #f "arg")) (_o$3290 key) (_o$3291 i) (_o$3292 at)) (jolt-vector _o$3289 _o$3290 _o$3291 _o$3292))) (rejects (if (jolt-contains? (jolt-invoke (var-deref "clojure.core" "deref") memo) mk) (jolt-get (jolt-invoke (var-deref "clojure.core" "deref") memo) mk) (let* ((r (> (jolt-invoke (var-deref "jolt.passes.types" "isolated-diag-count") body (jolt-assoc base-env (jolt-nth params i) at) env) base))) (begin (jolt-invoke (var-deref "clojure.core" "swap!") memo jolt-assoc mk r) r))))) (if (jolt-truthy? rejects) (let* ((_a$3311 (var-deref "clojure.core" "swap!")) (_a$3312 (jolt-get env (keyword #f "diags"))) (_a$3313 jolt-conj) (_a$3314 (let* ((_o$3301 (keyword #f "op")) (_o$3302 (keyword #f "user-call")) (_o$3303 (keyword #f "argpos")) (_o$3304 i) (_o$3305 (keyword #f "type")) (_o$3306 (jolt-invoke (var-deref "jolt.passes.types.check" "type-name") at)) (_o$3307 (keyword #f "pos")) (_o$3308 pos) (_o$3309 (keyword #f "msg")) (_o$3310 (let* ((_a$3293 (var-deref "clojure.core" "str")) (_a$3294 "argument ") (_a$3295 (jolt-inc i)) (_a$3296 " to `") (_a$3297 (jolt-get sig (keyword #f "name"))) (_a$3298 "` is ") (_a$3299 (jolt-invoke (var-deref "jolt.passes.types.check" "type-name") at)) (_a$3300 ", which its body provably rejects")) (jolt-invoke _a$3293 _a$3294 _a$3295 _a$3296 _a$3297 _a$3298 _a$3299 _a$3300)))) (jolt-hash-map _o$3301 _o$3302 _o$3303 _o$3304 _o$3305 _o$3306 _o$3307 _o$3308 _o$3309 _o$3310)))) (jolt-invoke _a$3311 _a$3312 _a$3313 _a$3314)) jolt-nil)) jolt-nil)) jolt-nil)))) (_a$3316 jolt-nil) (_a$3317 (jolt-range npar))) (jolt-reduce _a$3315 _a$3316 _a$3317))))) (jolt-invoke (var-deref "clojure.core" "reset!") cset prev))) jolt-nil)))))) check-user-call))) (guard (e (#t #f)) - (def-var-with-meta! "jolt.passes.types" "num-ops" (let* ((_o$3385 "+") (_o$3386 "-") (_o$3387 "*") (_o$3388 "/") (_o$3389 "inc") (_o$3390 "dec") (_o$3391 "mod") (_o$3392 "rem") (_o$3393 "quot") (_o$3394 "min") (_o$3395 "max") (_o$3396 "abs") (_o$3397 "bit-and") (_o$3398 "bit-or") (_o$3399 "bit-xor") (_o$3400 "bit-not") (_o$3401 "bit-shift-left") (_o$3402 "bit-shift-right")) (jolt-hash-set _o$3385 _o$3386 _o$3387 _o$3388 _o$3389 _o$3390 _o$3391 _o$3392 _o$3393 _o$3394 _o$3395 _o$3396 _o$3397 _o$3398 _o$3399 _o$3400 _o$3401 _o$3402)) (jolt-hash-map (keyword #f "private") #t))) + (def-var! "jolt.passes.types" "set-rtenv!" (letrec ((set-rtenv! (lambda (m) (let fnrec3318 ((m m)) (jolt-invoke (var-deref "clojure.core" "swap!") (var-deref "jolt.passes.types" "config-box") jolt-assoc (keyword #f "rtenv") (let* ((or__14__auto m)) (if (jolt-truthy? or__14__auto) or__14__auto (jolt-hash-map)))))))) set-rtenv!))) (guard (e (#t #f)) - (def-var-with-meta! "jolt.passes.types" "seq-ops" (let* ((_o$3403 "count") (_o$3404 "first") (_o$3405 "rest") (_o$3406 "next") (_o$3407 "seq") (_o$3408 "nth")) (jolt-hash-set _o$3403 _o$3404 _o$3405 _o$3406 _o$3407 _o$3408)) (jolt-hash-map (keyword #f "private") #t))) + (def-var! "jolt.passes.types" "set-record-shapes!" (letrec ((set-record-shapes! (lambda (m) (let fnrec3319 ((m m)) (jolt-invoke (var-deref "clojure.core" "swap!") (var-deref "jolt.passes.types" "config-box") jolt-assoc (keyword #f "record-shapes") (let* ((or__14__auto m)) (if (jolt-truthy? or__14__auto) or__14__auto (jolt-hash-map)))))))) set-record-shapes!))) (guard (e (#t #f)) - (def-var! "jolt.passes.types" "type-name" (letrec ((type-name (lambda (t) (let fnrec3409 ((t t)) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.passes.types.lattice" "union-type?") t)) (let* ((_a$3411 (lambda (s m) (let fnrec3410 ((s s) (m m)) (if (jolt= s "") (jolt-invoke type-name m) (jolt-invoke (var-deref "clojure.core" "str") s " or " (jolt-invoke type-name m)))))) (_a$3412 "") (_a$3413 (jolt-invoke (var-deref "jolt.passes.types.lattice" "umembers") t))) (jolt-reduce _a$3411 _a$3412 _a$3413)) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.passes.types.lattice" "struct-type?") t)) "a map" (if (jolt-truthy? (jolt-invoke (var-deref "jolt.passes.types.lattice" "vec-type?") t)) "a vector" (if (jolt-truthy? (jolt-invoke (var-deref "jolt.passes.types.lattice" "set-type?") t)) "a set" (if (jolt= t (keyword #f "str")) "a string" (if (jolt= t (keyword #f "kw")) "a keyword" (if (jolt= t (keyword #f "num")) "a number" (if (jolt= t (keyword #f "phm")) "a map" (if (jolt-truthy? (keyword #f "else")) (jolt-invoke (var-deref "clojure.core" "str") t) jolt-nil))))))))))))) type-name))) + (def-var! "jolt.passes.types" "set-protocol-methods!" (letrec ((set-protocol-methods! (lambda (m) (let fnrec3320 ((m m)) (jolt-invoke (var-deref "clojure.core" "swap!") (var-deref "jolt.passes.types" "config-box") jolt-assoc (keyword #f "protocol-methods") (let* ((or__14__auto m)) (if (jolt-truthy? or__14__auto) or__14__auto (jolt-hash-map)))))))) set-protocol-methods!))) (guard (e (#t #f)) - (def-var! "jolt.passes.types" "check-invoke" (letrec ((check-invoke (lambda (cn args arg-types pos env) (let fnrec3414 ((cn cn) (args args) (arg-types arg-types) (pos pos) (env env)) (if (jolt-contains? (var-deref "jolt.passes.types" "num-ops") cn) (let* ((_a$3437 (lambda (_ i) (let fnrec3415 ((_ _) (i i)) (begin (let* ((t (jolt-nth arg-types i))) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.passes.types" "not-number?") t)) (let* ((_a$3433 (var-deref "clojure.core" "swap!")) (_a$3434 (jolt-get env (keyword #f "diags"))) (_a$3435 jolt-conj) (_a$3436 (let* ((_o$3423 (keyword #f "op")) (_o$3424 cn) (_o$3425 (keyword #f "argpos")) (_o$3426 i) (_o$3427 (keyword #f "type")) (_o$3428 (jolt-invoke (var-deref "jolt.passes.types" "type-name") t)) (_o$3429 (keyword #f "pos")) (_o$3430 pos) (_o$3431 (keyword #f "msg")) (_o$3432 (let* ((_a$3416 (var-deref "clojure.core" "str")) (_a$3417 "`") (_a$3418 cn) (_a$3419 "` requires a number, but argument ") (_a$3420 (jolt-inc i)) (_a$3421 " is ") (_a$3422 (jolt-invoke (var-deref "jolt.passes.types" "type-name") t))) (jolt-invoke _a$3416 _a$3417 _a$3418 _a$3419 _a$3420 _a$3421 _a$3422)))) (jolt-hash-map _o$3423 _o$3424 _o$3425 _o$3426 _o$3427 _o$3428 _o$3429 _o$3430 _o$3431 _o$3432)))) (jolt-invoke _a$3433 _a$3434 _a$3435 _a$3436)) jolt-nil)) jolt-nil)))) (_a$3438 jolt-nil) (_a$3439 (jolt-range (jolt-count args)))) (jolt-reduce _a$3437 _a$3438 _a$3439)) (if (jolt-truthy? (let* ((and__13__auto (jolt-contains? (var-deref "jolt.passes.types" "seq-ops") cn))) (if (jolt-truthy? and__13__auto) (> (jolt-count args) 0) and__13__auto))) (let* ((t (jolt-nth arg-types 0))) (if (jolt-truthy? (jolt-invoke (var-deref "jolt.passes.types" "not-seqable?") t)) (let* ((_a$3457 (var-deref "clojure.core" "swap!")) (_a$3458 (jolt-get env (keyword #f "diags"))) (_a$3459 jolt-conj) (_a$3460 (let* ((_o$3447 (keyword #f "op")) (_o$3448 cn) (_o$3449 (keyword #f "argpos")) (_o$3450 0) (_o$3451 (keyword #f "type")) (_o$3452 (jolt-invoke (var-deref "jolt.passes.types" "type-name") t)) (_o$3453 (keyword #f "pos")) (_o$3454 pos) (_o$3455 (keyword #f "msg")) (_o$3456 (let* ((_a$3440 (var-deref "clojure.core" "str")) (_a$3441 "`") (_a$3442 cn) (_a$3443 "` requires ") (_a$3444 (if (jolt= cn "count") "a countable collection" "a seqable")) (_a$3445 ", but argument 1 is ") (_a$3446 (jolt-invoke (var-deref "jolt.passes.types" "type-name") t))) (jolt-invoke _a$3440 _a$3441 _a$3442 _a$3443 _a$3444 _a$3445 _a$3446)))) (jolt-hash-map _o$3447 _o$3448 _o$3449 _o$3450 _o$3451 _o$3452 _o$3453 _o$3454 _o$3455 _o$3456)))) (jolt-invoke _a$3457 _a$3458 _a$3459 _a$3460)) jolt-nil)) (if (jolt-truthy? (keyword #f "else")) jolt-nil jolt-nil))))))) check-invoke))) + (def-var! "jolt.passes.types" "set-map-shapes!" (letrec ((set-map-shapes! (lambda (b) (let fnrec3321 ((b b)) (jolt-invoke (var-deref "clojure.core" "swap!") (var-deref "jolt.passes.types" "config-box") jolt-assoc (keyword #f "map-shapes?") (jolt-invoke (var-deref "clojure.core" "boolean") b)))))) set-map-shapes!))) (guard (e (#t #f)) - (def-var! "jolt.passes.types" "all-any-env" (letrec ((all-any-env (lambda (params) (let fnrec3461 ((params params)) (let* ((_a$3463 (lambda (e p) (let fnrec3462 ((e e) (p p)) (jolt-assoc e p (keyword #f "any"))))) (_a$3464 (jolt-hash-map)) (_a$3465 params)) (jolt-reduce _a$3463 _a$3464 _a$3465)))))) all-any-env))) + (def-var! "jolt.passes.types" "set-vtypes!" (letrec ((set-vtypes! (lambda (m) (let fnrec3322 ((m m)) (jolt-invoke (var-deref "clojure.core" "swap!") (var-deref "jolt.passes.types" "config-box") jolt-assoc (keyword #f "vtypes") (let* ((or__14__auto m)) (if (jolt-truthy? or__14__auto) or__14__auto (jolt-hash-map)))))))) set-vtypes!))) (guard (e (#t #f)) - (def-var! "jolt.passes.types" "isolated-diag-count" (letrec ((isolated-diag-count (lambda (body tenv env) (let fnrec3466 ((body body) (tenv tenv) (env env)) (let* ((sub (jolt-assoc env (keyword #f "diags") (jolt-invoke (var-deref "clojure.core" "atom") (jolt-vector))))) (begin (jolt-invoke (var-deref "jolt.passes.types" "infer") body tenv sub) (jolt-count (jolt-invoke (var-deref "clojure.core" "deref") (jolt-get sub (keyword #f "diags")))))))))) isolated-diag-count))) + (def-var! "jolt.passes.types" "join-types" (letrec ((join-types (lambda (a b) (let fnrec3323 ((a a) (b b)) (jolt-invoke (var-deref "jolt.passes.types.lattice" "join-t") a b))))) join-types))) (guard (e (#t #f)) - (def-var! "jolt.passes.types" "register-user-fn!" (letrec ((register-user-fn! (lambda (node env) (let fnrec3467 ((node node) (env env)) (let* ((init (jolt-get node (keyword #f "init"))) (m (jolt-get node (keyword #f "meta"))) (redefable (let* ((and__13__auto m)) (if (jolt-truthy? and__13__auto) (let* ((or__14__auto (jolt-get m (keyword #f "redef")))) (if (jolt-truthy? or__14__auto) or__14__auto (jolt-get m (keyword #f "dynamic")))) and__13__auto)))) (if (jolt-truthy? (let* ((and__13__auto (jolt-not redefable))) (if (jolt-truthy? and__13__auto) (jolt= (keyword #f "fn") (jolt-get init (keyword #f "op"))) and__13__auto))) (let* ((arities (jolt-get init (keyword #f "arities")))) (if (jolt= 1 (jolt-count arities)) (let* ((ar (jolt-first arities))) (if (jolt-not (jolt-get ar (keyword #f "rest"))) (let* ((_a$3478 (var-deref "clojure.core" "swap!")) (_a$3479 (jolt-get env (keyword #f "user-sigs"))) (_a$3480 jolt-assoc) (_a$3481 (let* ((_a$3468 (var-deref "clojure.core" "str")) (_a$3469 (jolt-get node (keyword #f "ns"))) (_a$3470 "/") (_a$3471 (jolt-get node (keyword #f "name")))) (jolt-invoke _a$3468 _a$3469 _a$3470 _a$3471))) (_a$3482 (let* ((_o$3472 (keyword #f "name")) (_o$3473 (jolt-get node (keyword #f "name"))) (_o$3474 (keyword #f "params")) (_o$3475 (jolt-get ar (keyword #f "params"))) (_o$3476 (keyword #f "body")) (_o$3477 (jolt-get ar (keyword #f "body")))) (jolt-hash-map _o$3472 _o$3473 _o$3474 _o$3475 _o$3476 _o$3477)))) (jolt-invoke _a$3478 _a$3479 _a$3480 _a$3481 _a$3482)) jolt-nil)) jolt-nil)) jolt-nil)))))) register-user-fn!))) + (def-var! "jolt.passes.types" "reset-escapes!" (letrec ((reset-escapes! (lambda () (let fnrec3324 () (jolt-invoke (var-deref "clojure.core" "reset!") (var-deref "jolt.passes.types" "escapes-box") (jolt-hash-set)))))) reset-escapes!))) (guard (e (#t #f)) - (def-var! "jolt.passes.types" "check-user-call" (letrec ((check-user-call (lambda (key sig arg-types pos env) (let fnrec3483 ((key key) (sig sig) (arg-types arg-types) (pos pos) (env env)) (let* ((cset (jolt-get env (keyword #f "checking-set")))) (if (jolt-not (jolt-contains? (jolt-invoke (var-deref "clojure.core" "deref") cset) key)) (let* ((prev (jolt-invoke (var-deref "clojure.core" "deref") cset))) (begin (jolt-invoke (var-deref "clojure.core" "reset!") cset (jolt-conj prev key)) (let* ((params (jolt-get sig (keyword #f "params"))) (body (jolt-get sig (keyword #f "body"))) (npar (jolt-count params)) (nargs (jolt-count arg-types)) (memo (jolt-get env (keyword #f "diag-memo")))) (if (jolt-truthy? (jolt-invoke (var-deref "clojure.core" "not=") npar nargs)) (let* ((_a$3492 (var-deref "clojure.core" "swap!")) (_a$3493 (jolt-get env (keyword #f "diags"))) (_a$3494 jolt-conj) (_a$3495 (let* ((_o$3484 (keyword #f "op")) (_o$3485 (keyword #f "user-call")) (_o$3486 (keyword #f "type")) (_o$3487 (keyword #f "arity")) (_o$3488 (keyword #f "pos")) (_o$3489 pos) (_o$3490 (keyword #f "msg")) (_o$3491 (jolt-invoke (var-deref "clojure.core" "str") "wrong number of args (" nargs ") passed to `" (jolt-get sig (keyword #f "name")) "` (expected " npar ")"))) (jolt-hash-map _o$3484 _o$3485 _o$3486 _o$3487 _o$3488 _o$3489 _o$3490 _o$3491)))) (jolt-invoke _a$3492 _a$3493 _a$3494 _a$3495)) (let* ((base-env (jolt-invoke (var-deref "jolt.passes.types" "all-any-env") params)) (base (let* ((bk (let* ((_o$3496 (keyword #f "base")) (_o$3497 key)) (jolt-vector _o$3496 _o$3497)))) (if (jolt-contains? (jolt-invoke (var-deref "clojure.core" "deref") memo) bk) (jolt-get (jolt-invoke (var-deref "clojure.core" "deref") memo) bk) (let* ((b (jolt-invoke (var-deref "jolt.passes.types" "isolated-diag-count") body base-env env))) (begin (jolt-invoke (var-deref "clojure.core" "swap!") memo jolt-assoc bk b) b)))))) (let* ((_a$3525 (lambda (_ i) (let fnrec3498 ((_ _) (i i)) (begin (let* ((at (jolt-nth arg-types i))) (if (jolt-truthy? (let* ((and__13__auto (jolt-invoke (var-deref "clojure.core" "not=") at (keyword #f "any")))) (if (jolt-truthy? and__13__auto) (jolt-invoke (var-deref "clojure.core" "not=") at (keyword #f "truthy")) and__13__auto))) (let* ((mk (let* ((_o$3499 (keyword #f "arg")) (_o$3500 key) (_o$3501 i) (_o$3502 at)) (jolt-vector _o$3499 _o$3500 _o$3501 _o$3502))) (rejects (if (jolt-contains? (jolt-invoke (var-deref "clojure.core" "deref") memo) mk) (jolt-get (jolt-invoke (var-deref "clojure.core" "deref") memo) mk) (let* ((r (> (jolt-invoke (var-deref "jolt.passes.types" "isolated-diag-count") body (jolt-assoc base-env (jolt-nth params i) at) env) base))) (begin (jolt-invoke (var-deref "clojure.core" "swap!") memo jolt-assoc mk r) r))))) (if (jolt-truthy? rejects) (let* ((_a$3521 (var-deref "clojure.core" "swap!")) (_a$3522 (jolt-get env (keyword #f "diags"))) (_a$3523 jolt-conj) (_a$3524 (let* ((_o$3511 (keyword #f "op")) (_o$3512 (keyword #f "user-call")) (_o$3513 (keyword #f "argpos")) (_o$3514 i) (_o$3515 (keyword #f "type")) (_o$3516 (jolt-invoke (var-deref "jolt.passes.types" "type-name") at)) (_o$3517 (keyword #f "pos")) (_o$3518 pos) (_o$3519 (keyword #f "msg")) (_o$3520 (let* ((_a$3503 (var-deref "clojure.core" "str")) (_a$3504 "argument ") (_a$3505 (jolt-inc i)) (_a$3506 " to `") (_a$3507 (jolt-get sig (keyword #f "name"))) (_a$3508 "` is ") (_a$3509 (jolt-invoke (var-deref "jolt.passes.types" "type-name") at)) (_a$3510 ", which its body provably rejects")) (jolt-invoke _a$3503 _a$3504 _a$3505 _a$3506 _a$3507 _a$3508 _a$3509 _a$3510)))) (jolt-hash-map _o$3511 _o$3512 _o$3513 _o$3514 _o$3515 _o$3516 _o$3517 _o$3518 _o$3519 _o$3520)))) (jolt-invoke _a$3521 _a$3522 _a$3523 _a$3524)) jolt-nil)) jolt-nil)) jolt-nil)))) (_a$3526 jolt-nil) (_a$3527 (jolt-range npar))) (jolt-reduce _a$3525 _a$3526 _a$3527))))) (jolt-invoke (var-deref "clojure.core" "reset!") cset prev))) jolt-nil)))))) check-user-call))) + (def-var! "jolt.passes.types" "collected-escapes" (letrec ((collected-escapes (lambda () (let fnrec3325 () (jolt-invoke (var-deref "clojure.core" "vec") (jolt-invoke (var-deref "clojure.core" "deref") (var-deref "jolt.passes.types" "escapes-box"))))))) collected-escapes))) (guard (e (#t #f)) - (def-var! "jolt.passes.types" "set-rtenv!" (letrec ((set-rtenv! (lambda (m) (let fnrec3528 ((m m)) (jolt-invoke (var-deref "clojure.core" "swap!") (var-deref "jolt.passes.types" "config-box") jolt-assoc (keyword #f "rtenv") (let* ((or__14__auto m)) (if (jolt-truthy? or__14__auto) or__14__auto (jolt-hash-map)))))))) set-rtenv!))) + (def-var! "jolt.passes.types" "check-form" (letrec ((check-form (case-lambda ((node) (let fnrec3326 ((node node)) (jolt-invoke check-form node #f))) ((node strict?) (let fnrec3327 ((node node) (strict? strict?)) (let* ((env (jolt-invoke (var-deref "jolt.passes.types" "mk-env") #t strict?))) (begin (jolt-invoke (var-deref "jolt.passes.types" "infer") node (jolt-hash-map) env) (jolt-invoke (var-deref "clojure.core" "vec") (jolt-invoke (var-deref "clojure.core" "deref") (jolt-get env (keyword #f "diags"))))))))))) check-form))) (guard (e (#t #f)) - (def-var! "jolt.passes.types" "set-record-shapes!" (letrec ((set-record-shapes! (lambda (m) (let fnrec3529 ((m m)) (jolt-invoke (var-deref "clojure.core" "swap!") (var-deref "jolt.passes.types" "config-box") jolt-assoc (keyword #f "record-shapes") (let* ((or__14__auto m)) (if (jolt-truthy? or__14__auto) or__14__auto (jolt-hash-map)))))))) set-record-shapes!))) + (def-var! "jolt.passes.types" "infer-body" (letrec ((infer-body (lambda (body tenv) (let fnrec3328 ((body body) (tenv tenv)) (let* ((env (jolt-invoke (var-deref "jolt.passes.types" "mk-env") #f #f)) (r (jolt-invoke (var-deref "jolt.passes.types" "infer") body tenv env))) (let* ((_o$3329 (jolt-nth r 0)) (_o$3330 (jolt-nth r 1)) (_o$3331 (jolt-invoke (var-deref "clojure.core" "deref") (jolt-get env (keyword #f "calls"))))) (jolt-vector _o$3329 _o$3330 _o$3331))))))) infer-body))) (guard (e (#t #f)) - (def-var! "jolt.passes.types" "set-protocol-methods!" (letrec ((set-protocol-methods! (lambda (m) (let fnrec3530 ((m m)) (jolt-invoke (var-deref "clojure.core" "swap!") (var-deref "jolt.passes.types" "config-box") jolt-assoc (keyword #f "protocol-methods") (let* ((or__14__auto m)) (if (jolt-truthy? or__14__auto) or__14__auto (jolt-hash-map)))))))) set-protocol-methods!))) + (def-var! "jolt.passes.types" "reinfer-def" (letrec ((reinfer-def (lambda (def-node ptmap) (let fnrec3332 ((def-node def-node) (ptmap ptmap)) (let* ((fnode (jolt-get def-node (keyword #f "init"))) (env (jolt-invoke (var-deref "jolt.passes.types" "mk-env") #f #f)) (shapes (jolt-get env (keyword #f "record-shapes")))) (if (jolt= (keyword #f "fn") (jolt-get fnode (keyword #f "op"))) (jolt-assoc def-node (keyword #f "init") (jolt-assoc fnode (keyword #f "arities") (let* ((_a$3338 (var-deref "clojure.core" "mapv")) (_a$3339 (lambda (a) (let fnrec3333 ((a a)) (let* ((pt (let* ((_a$3335 (lambda (m pr) (let fnrec3334 ((m m) (pr pr)) (let* ((nm (jolt-nth pr 0)) (e (jolt-get shapes (jolt-nth pr 1)))) (if (jolt-truthy? (let* ((and__13__auto e)) (if (jolt-truthy? and__13__auto) (jolt-not (jolt-contains? m nm)) and__13__auto))) (jolt-assoc m nm (jolt-invoke (var-deref "jolt.passes.types" "record-type-from-entry") e (var-deref "jolt.passes.types.lattice" "type-depth") shapes)) m))))) (_a$3336 ptmap) (_a$3337 (jolt-get a (keyword #f "phints")))) (jolt-reduce _a$3335 _a$3336 _a$3337)))) (jolt-assoc a (keyword #f "body") (jolt-nth (jolt-invoke (var-deref "jolt.passes.types" "infer") (jolt-get a (keyword #f "body")) pt env) 1)))))) (_a$3340 (jolt-get fnode (keyword #f "arities")))) (jolt-invoke _a$3338 _a$3339 _a$3340)))) def-node)))))) reinfer-def))) (guard (e (#t #f)) - (def-var! "jolt.passes.types" "set-map-shapes!" (letrec ((set-map-shapes! (lambda (b) (let fnrec3531 ((b b)) (jolt-invoke (var-deref "clojure.core" "swap!") (var-deref "jolt.passes.types" "config-box") jolt-assoc (keyword #f "map-shapes?") (jolt-invoke (var-deref "clojure.core" "boolean") b)))))) set-map-shapes!))) + (def-var! "jolt.passes.types" "phint-seed" (letrec ((phint-seed (lambda (params phints) (let fnrec3341 ((params params) (phints phints)) (let* ((shapes (jolt-get (jolt-invoke (var-deref "clojure.core" "deref") (var-deref "jolt.passes.types" "config-box")) (keyword #f "record-shapes"))) (m (let* ((_a$3346 (lambda (acc pr) (let fnrec3342 ((acc acc) (pr pr)) (let* ((_a$3343 acc) (_a$3344 (jolt-nth pr 0)) (_a$3345 (jolt-nth pr 1))) (jolt-assoc _a$3343 _a$3344 _a$3345))))) (_a$3347 (jolt-hash-map)) (_a$3348 phints)) (jolt-reduce _a$3346 _a$3347 _a$3348)))) (jolt-invoke (var-deref "clojure.core" "mapv") (lambda (nm) (let fnrec3349 ((nm nm)) (let* ((ck (jolt-get m nm)) (e (let* ((and__13__auto ck)) (if (jolt-truthy? and__13__auto) (jolt-get shapes ck) and__13__auto)))) (if (jolt-truthy? e) (jolt-invoke (var-deref "jolt.passes.types" "record-type-from-entry") e (var-deref "jolt.passes.types.lattice" "type-depth") shapes) jolt-nil)))) params)))))) phint-seed))) (guard (e (#t #f)) - (def-var! "jolt.passes.types" "set-vtypes!" (letrec ((set-vtypes! (lambda (m) (let fnrec3532 ((m m)) (jolt-invoke (var-deref "clojure.core" "swap!") (var-deref "jolt.passes.types" "config-box") jolt-assoc (keyword #f "vtypes") (let* ((or__14__auto m)) (if (jolt-truthy? or__14__auto) or__14__auto (jolt-hash-map)))))))) set-vtypes!))) + (def-var! "jolt.passes.types" "set-check-mode!" (letrec ((set-check-mode! (lambda (on strict?) (let fnrec3350 ((on on) (strict? strict?)) (jolt-invoke (var-deref "clojure.core" "reset!") (var-deref "jolt.passes.types" "check-mode-box") (let* ((_o$3351 (keyword #f "on")) (_o$3352 (if (jolt-truthy? on) #t #f)) (_o$3353 (keyword #f "strict")) (_o$3354 (if (jolt-truthy? strict?) #t #f))) (jolt-hash-map _o$3351 _o$3352 _o$3353 _o$3354))))))) set-check-mode!))) (guard (e (#t #f)) - (def-var! "jolt.passes.types" "join-types" (letrec ((join-types (lambda (a b) (let fnrec3533 ((a a) (b b)) (jolt-invoke (var-deref "jolt.passes.types.lattice" "join-t") a b))))) join-types))) + (def-var! "jolt.passes.types" "take-diags!" (letrec ((take-diags! (lambda () (let fnrec3355 () (let* ((d (jolt-invoke (var-deref "clojure.core" "deref") (var-deref "jolt.passes.types" "last-diags-box")))) (begin (jolt-invoke (var-deref "clojure.core" "reset!") (var-deref "jolt.passes.types" "last-diags-box") (jolt-vector)) d)))))) take-diags!))) (guard (e (#t #f)) - (def-var! "jolt.passes.types" "reset-escapes!" (letrec ((reset-escapes! (lambda () (let fnrec3534 () (jolt-invoke (var-deref "clojure.core" "reset!") (var-deref "jolt.passes.types" "escapes-box") (jolt-hash-set)))))) reset-escapes!))) -(guard (e (#t #f)) - (def-var! "jolt.passes.types" "collected-escapes" (letrec ((collected-escapes (lambda () (let fnrec3535 () (jolt-invoke (var-deref "clojure.core" "vec") (jolt-invoke (var-deref "clojure.core" "deref") (var-deref "jolt.passes.types" "escapes-box"))))))) collected-escapes))) -(guard (e (#t #f)) - (def-var! "jolt.passes.types" "check-form" (letrec ((check-form (case-lambda ((node) (let fnrec3536 ((node node)) (jolt-invoke check-form node #f))) ((node strict?) (let fnrec3537 ((node node) (strict? strict?)) (let* ((env (jolt-invoke (var-deref "jolt.passes.types" "mk-env") #t strict?))) (begin (jolt-invoke (var-deref "jolt.passes.types" "infer") node (jolt-hash-map) env) (jolt-invoke (var-deref "clojure.core" "vec") (jolt-invoke (var-deref "clojure.core" "deref") (jolt-get env (keyword #f "diags"))))))))))) check-form))) -(guard (e (#t #f)) - (def-var! "jolt.passes.types" "infer-body" (letrec ((infer-body (lambda (body tenv) (let fnrec3538 ((body body) (tenv tenv)) (let* ((env (jolt-invoke (var-deref "jolt.passes.types" "mk-env") #f #f)) (r (jolt-invoke (var-deref "jolt.passes.types" "infer") body tenv env))) (let* ((_o$3539 (jolt-nth r 0)) (_o$3540 (jolt-nth r 1)) (_o$3541 (jolt-invoke (var-deref "clojure.core" "deref") (jolt-get env (keyword #f "calls"))))) (jolt-vector _o$3539 _o$3540 _o$3541))))))) infer-body))) -(guard (e (#t #f)) - (def-var! "jolt.passes.types" "reinfer-def" (letrec ((reinfer-def (lambda (def-node ptmap) (let fnrec3542 ((def-node def-node) (ptmap ptmap)) (let* ((fnode (jolt-get def-node (keyword #f "init"))) (env (jolt-invoke (var-deref "jolt.passes.types" "mk-env") #f #f)) (shapes (jolt-get env (keyword #f "record-shapes")))) (if (jolt= (keyword #f "fn") (jolt-get fnode (keyword #f "op"))) (jolt-assoc def-node (keyword #f "init") (jolt-assoc fnode (keyword #f "arities") (let* ((_a$3548 (var-deref "clojure.core" "mapv")) (_a$3549 (lambda (a) (let fnrec3543 ((a a)) (let* ((pt (let* ((_a$3545 (lambda (m pr) (let fnrec3544 ((m m) (pr pr)) (let* ((nm (jolt-nth pr 0)) (e (jolt-get shapes (jolt-nth pr 1)))) (if (jolt-truthy? (let* ((and__13__auto e)) (if (jolt-truthy? and__13__auto) (jolt-not (jolt-contains? m nm)) and__13__auto))) (jolt-assoc m nm (jolt-invoke (var-deref "jolt.passes.types" "record-type-from-entry") e (var-deref "jolt.passes.types.lattice" "type-depth") shapes)) m))))) (_a$3546 ptmap) (_a$3547 (jolt-get a (keyword #f "phints")))) (jolt-reduce _a$3545 _a$3546 _a$3547)))) (jolt-assoc a (keyword #f "body") (jolt-nth (jolt-invoke (var-deref "jolt.passes.types" "infer") (jolt-get a (keyword #f "body")) pt env) 1)))))) (_a$3550 (jolt-get fnode (keyword #f "arities")))) (jolt-invoke _a$3548 _a$3549 _a$3550)))) def-node)))))) reinfer-def))) -(guard (e (#t #f)) - (def-var! "jolt.passes.types" "phint-seed" (letrec ((phint-seed (lambda (params phints) (let fnrec3551 ((params params) (phints phints)) (let* ((shapes (jolt-get (jolt-invoke (var-deref "clojure.core" "deref") (var-deref "jolt.passes.types" "config-box")) (keyword #f "record-shapes"))) (m (let* ((_a$3556 (lambda (acc pr) (let fnrec3552 ((acc acc) (pr pr)) (let* ((_a$3553 acc) (_a$3554 (jolt-nth pr 0)) (_a$3555 (jolt-nth pr 1))) (jolt-assoc _a$3553 _a$3554 _a$3555))))) (_a$3557 (jolt-hash-map)) (_a$3558 phints)) (jolt-reduce _a$3556 _a$3557 _a$3558)))) (jolt-invoke (var-deref "clojure.core" "mapv") (lambda (nm) (let fnrec3559 ((nm nm)) (let* ((ck (jolt-get m nm)) (e (let* ((and__13__auto ck)) (if (jolt-truthy? and__13__auto) (jolt-get shapes ck) and__13__auto)))) (if (jolt-truthy? e) (jolt-invoke (var-deref "jolt.passes.types" "record-type-from-entry") e (var-deref "jolt.passes.types.lattice" "type-depth") shapes) jolt-nil)))) params)))))) phint-seed))) -(guard (e (#t #f)) - (def-var! "jolt.passes.types" "set-check-mode!" (letrec ((set-check-mode! (lambda (on strict?) (let fnrec3560 ((on on) (strict? strict?)) (jolt-invoke (var-deref "clojure.core" "reset!") (var-deref "jolt.passes.types" "check-mode-box") (let* ((_o$3561 (keyword #f "on")) (_o$3562 (if (jolt-truthy? on) #t #f)) (_o$3563 (keyword #f "strict")) (_o$3564 (if (jolt-truthy? strict?) #t #f))) (jolt-hash-map _o$3561 _o$3562 _o$3563 _o$3564))))))) set-check-mode!))) -(guard (e (#t #f)) - (def-var! "jolt.passes.types" "take-diags!" (letrec ((take-diags! (lambda () (let fnrec3565 () (let* ((d (jolt-invoke (var-deref "clojure.core" "deref") (var-deref "jolt.passes.types" "last-diags-box")))) (begin (jolt-invoke (var-deref "clojure.core" "reset!") (var-deref "jolt.passes.types" "last-diags-box") (jolt-vector)) d)))))) take-diags!))) -(guard (e (#t #f)) - (def-var! "jolt.passes.types" "run-inference" (letrec ((run-inference (lambda (opt) (let fnrec3566 ((opt opt)) (if (jolt-truthy? (jolt-get (jolt-invoke (var-deref "clojure.core" "deref") (var-deref "jolt.passes.types" "check-mode-box")) (keyword #f "on"))) (let* ((env (jolt-invoke (var-deref "jolt.passes.types" "mk-env") #t (jolt-get (jolt-invoke (var-deref "clojure.core" "deref") (var-deref "jolt.passes.types" "check-mode-box")) (keyword #f "strict")))) (r (jolt-invoke (var-deref "jolt.passes.types" "infer-top") opt env))) (begin (jolt-invoke (var-deref "clojure.core" "reset!") (var-deref "jolt.passes.types" "last-diags-box") (jolt-invoke (var-deref "clojure.core" "deref") (jolt-get env (keyword #f "diags")))) r)) (jolt-invoke (var-deref "jolt.passes.types" "infer-top") opt (jolt-invoke (var-deref "jolt.passes.types" "mk-env") #f #f))))))) run-inference))) + (def-var! "jolt.passes.types" "run-inference" (letrec ((run-inference (lambda (opt) (let fnrec3356 ((opt opt)) (if (jolt-truthy? (jolt-get (jolt-invoke (var-deref "clojure.core" "deref") (var-deref "jolt.passes.types" "check-mode-box")) (keyword #f "on"))) (let* ((env (jolt-invoke (var-deref "jolt.passes.types" "mk-env") #t (jolt-get (jolt-invoke (var-deref "clojure.core" "deref") (var-deref "jolt.passes.types" "check-mode-box")) (keyword #f "strict")))) (r (jolt-invoke (var-deref "jolt.passes.types" "infer-top") opt env))) (begin (jolt-invoke (var-deref "clojure.core" "reset!") (var-deref "jolt.passes.types" "last-diags-box") (jolt-invoke (var-deref "clojure.core" "deref") (jolt-get env (keyword #f "diags")))) r)) (jolt-invoke (var-deref "jolt.passes.types" "infer-top") opt (jolt-invoke (var-deref "jolt.passes.types" "mk-env") #f #f))))))) run-inference))) (guard (e (#t #f)) (def-var-with-meta! "jolt.passes" "inline-fixpoint-cap" 8 (jolt-hash-map (keyword #f "private") #t))) (guard (e (#t #f)) - (def-var! "jolt.passes" "inline-eligible?" (letrec ((inline-eligible? (lambda (node) (let fnrec2878 ((node node)) (let* ((and__13__auto (jolt= (keyword #f "def") (jolt-get node (keyword #f "op"))))) (if (jolt-truthy? and__13__auto) (let* ((and__13__auto (jolt-get node (keyword #f "init")))) (if (jolt-truthy? and__13__auto) (let* ((and__13__auto (jolt= (keyword #f "fn") (jolt-get (jolt-get node (keyword #f "init")) (keyword #f "op"))))) (if (jolt-truthy? and__13__auto) (let* ((and__13__auto (jolt= 1 (jolt-count (jolt-get (jolt-get node (keyword #f "init")) (keyword #f "arities")))))) (if (jolt-truthy? and__13__auto) (jolt-not (jolt-get (jolt-first (jolt-get (jolt-get node (keyword #f "init")) (keyword #f "arities"))) (keyword #f "rest"))) and__13__auto)) and__13__auto)) and__13__auto)) and__13__auto)))))) inline-eligible?))) + (def-var! "jolt.passes" "inline-eligible?" (letrec ((inline-eligible? (lambda (node) (let fnrec3357 ((node node)) (let* ((and__13__auto (jolt= (keyword #f "def") (jolt-get node (keyword #f "op"))))) (if (jolt-truthy? and__13__auto) (let* ((and__13__auto (jolt-get node (keyword #f "init")))) (if (jolt-truthy? and__13__auto) (let* ((and__13__auto (jolt= (keyword #f "fn") (jolt-get (jolt-get node (keyword #f "init")) (keyword #f "op"))))) (if (jolt-truthy? and__13__auto) (let* ((and__13__auto (jolt= 1 (jolt-count (jolt-get (jolt-get node (keyword #f "init")) (keyword #f "arities")))))) (if (jolt-truthy? and__13__auto) (jolt-not (jolt-get (jolt-first (jolt-get (jolt-get node (keyword #f "init")) (keyword #f "arities"))) (keyword #f "rest"))) and__13__auto)) and__13__auto)) and__13__auto)) and__13__auto)))))) inline-eligible?))) (guard (e (#t #f)) - (def-var! "jolt.passes" "stash-of" (letrec ((stash-of (lambda (node) (let fnrec2879 ((node node)) (let* ((a (jolt-first (jolt-get (jolt-get node (keyword #f "init")) (keyword #f "arities"))))) (let* ((_o$2880 (keyword #f "params")) (_o$2881 (jolt-get a (keyword #f "params"))) (_o$2882 (keyword #f "body")) (_o$2883 (jolt-get a (keyword #f "body"))) (_o$2884 (keyword #f "nhints")) (_o$2885 (jolt-get a (keyword #f "nhints"))) (_o$2886 (keyword #f "ret")) (_o$2887 (jolt-get a (keyword #f "ret-nhint")))) (jolt-hash-map _o$2880 _o$2881 _o$2882 _o$2883 _o$2884 _o$2885 _o$2886 _o$2887))))))) stash-of))) + (def-var! "jolt.passes" "stash-of" (letrec ((stash-of (lambda (node) (let fnrec3358 ((node node)) (let* ((a (jolt-first (jolt-get (jolt-get node (keyword #f "init")) (keyword #f "arities"))))) (let* ((_o$3359 (keyword #f "params")) (_o$3360 (jolt-get a (keyword #f "params"))) (_o$3361 (keyword #f "body")) (_o$3362 (jolt-get a (keyword #f "body"))) (_o$3363 (keyword #f "nhints")) (_o$3364 (jolt-get a (keyword #f "nhints"))) (_o$3365 (keyword #f "ret")) (_o$3366 (jolt-get a (keyword #f "ret-nhint")))) (jolt-hash-map _o$3359 _o$3360 _o$3361 _o$3362 _o$3363 _o$3364 _o$3365 _o$3366))))))) stash-of))) (guard (e (#t #f)) - (def-var! "jolt.passes" "run-passes" (letrec ((run-passes (lambda (node ctx) (let fnrec2888 ((node node) (ctx ctx)) (begin (if (jolt-truthy? (let* ((and__13__auto (jolt-invoke (var-deref "jolt.host" "inline-enabled?") ctx))) (if (jolt-truthy? and__13__auto) (jolt-invoke (var-deref "jolt.passes" "inline-eligible?") node) and__13__auto))) (let* ((_a$2889 (var-deref "jolt.host" "stash-inline!")) (_a$2890 ctx) (_a$2891 (jolt-get node (keyword #f "ns"))) (_a$2892 (jolt-get node (keyword #f "name"))) (_a$2893 (jolt-invoke (var-deref "jolt.passes" "stash-of") node))) (jolt-invoke _a$2889 _a$2890 _a$2891 _a$2892 _a$2893)) jolt-nil) (jolt-invoke (var-deref "jolt.passes.numeric" "annotate") (if (jolt-truthy? (jolt-invoke (var-deref "jolt.host" "inline-enabled?") ctx)) (let* ((_ (jolt-invoke (var-deref "jolt.passes.inline" "set-rec-shapes!") (jolt-invoke (var-deref "jolt.host" "record-shapes") ctx))) (_ (jolt-invoke (var-deref "jolt.passes.types" "set-record-shapes!") (jolt-invoke (var-deref "jolt.host" "record-shapes") ctx))) (opt (let* ((i 0) (n (jolt-invoke (var-deref "jolt.passes.fold" "const-fold") node))) (let loop2894 ((i i) (n n)) (begin (jolt-invoke (var-deref "clojure.core" "reset!") (var-deref "jolt.passes.inline" "dirty") #f) (let* ((n2 (jolt-invoke (var-deref "jolt.passes.fold" "const-fold") (jolt-invoke (var-deref "jolt.passes.inline" "scalar-replace") (jolt-invoke (var-deref "jolt.passes.inline" "flatten-lets") (jolt-invoke (var-deref "jolt.passes.inline" "inline-node") n ctx)))))) (if (jolt-truthy? (let* ((and__13__auto (jolt-invoke (var-deref "clojure.core" "deref") (var-deref "jolt.passes.inline" "dirty")))) (if (jolt-truthy? and__13__auto) (< i (var-deref "jolt.passes" "inline-fixpoint-cap")) and__13__auto))) (loop2894 (jolt-inc i) n2) n2))))))) (jolt-invoke (var-deref "jolt.passes.fold" "const-fold") (jolt-invoke (var-deref "jolt.passes.types" "run-inference") opt))) (jolt-invoke (var-deref "jolt.passes.fold" "const-fold") node)))))))) run-passes))) \ No newline at end of file + (def-var! "jolt.passes" "run-passes" (letrec ((run-passes (lambda (node ctx) (let fnrec3367 ((node node) (ctx ctx)) (begin (if (jolt-truthy? (let* ((and__13__auto (jolt-invoke (var-deref "jolt.host" "inline-enabled?") ctx))) (if (jolt-truthy? and__13__auto) (jolt-invoke (var-deref "jolt.passes" "inline-eligible?") node) and__13__auto))) (let* ((_a$3368 (var-deref "jolt.host" "stash-inline!")) (_a$3369 ctx) (_a$3370 (jolt-get node (keyword #f "ns"))) (_a$3371 (jolt-get node (keyword #f "name"))) (_a$3372 (jolt-invoke (var-deref "jolt.passes" "stash-of") node))) (jolt-invoke _a$3368 _a$3369 _a$3370 _a$3371 _a$3372)) jolt-nil) (jolt-invoke (var-deref "jolt.passes.numeric" "annotate") (if (jolt-truthy? (jolt-invoke (var-deref "jolt.host" "inline-enabled?") ctx)) (let* ((_ (jolt-invoke (var-deref "jolt.passes.inline" "set-rec-shapes!") (jolt-invoke (var-deref "jolt.host" "record-shapes") ctx))) (_ (jolt-invoke (var-deref "jolt.passes.types" "set-record-shapes!") (jolt-invoke (var-deref "jolt.host" "record-shapes") ctx))) (opt (let* ((i 0) (n (jolt-invoke (var-deref "jolt.passes.fold" "const-fold") node))) (let loop3373 ((i i) (n n)) (begin (jolt-invoke (var-deref "clojure.core" "reset!") (var-deref "jolt.passes.inline" "dirty") #f) (let* ((n2 (jolt-invoke (var-deref "jolt.passes.fold" "const-fold") (jolt-invoke (var-deref "jolt.passes.inline" "scalar-replace") (jolt-invoke (var-deref "jolt.passes.inline" "flatten-lets") (jolt-invoke (var-deref "jolt.passes.inline" "inline-node") n ctx)))))) (if (jolt-truthy? (let* ((and__13__auto (jolt-invoke (var-deref "clojure.core" "deref") (var-deref "jolt.passes.inline" "dirty")))) (if (jolt-truthy? and__13__auto) (< i (var-deref "jolt.passes" "inline-fixpoint-cap")) and__13__auto))) (loop3373 (jolt-inc i) n2) n2))))))) (jolt-invoke (var-deref "jolt.passes.fold" "const-fold") (jolt-invoke (var-deref "jolt.passes.types" "run-inference") opt))) (jolt-invoke (var-deref "jolt.passes.fold" "const-fold") node)))))))) run-passes))) \ No newline at end of file diff --git a/jolt-core/jolt/passes/types.clj b/jolt-core/jolt/passes/types.clj index 3db3f65..fdae6da 100644 --- a/jolt-core/jolt/passes/types.clj +++ b/jolt-core/jolt/passes/types.clj @@ -6,6 +6,8 @@ propagate param types across a unit / the whole program. Weakly coupled to the IR-rewriting passes — shares the const-shape predicates (jolt.passes.fold)." (:require [jolt.passes.fold :refer [scalar-const? kw-callee? get-callee?]] + [jolt.passes.types.check :refer + [not-callable? type-name check-invoke register-user-fn!]] [jolt.passes.types.lattice :refer [velem selem sfields vec-type? set-type? struct-type? mk-vec mk-set mk-struct union-cap scalar-t? union-type? umembers union-of merge-fields @@ -82,8 +84,9 @@ ;; result of (rand-nth coll-of-structs) etc. types as the element. (def ^:private elem-fns #{"rand-nth" "first" "peek" "last" "nth" "fnext" "second"}) -;; the checker's emission points, defined after infer but referenced from it -(declare check-invoke check-user-call register-user-fn! not-callable? type-name) +;; defined after infer but referenced from it (the rest of the checker lives in +;; jolt.passes.types.check, required above) +(declare check-user-call) (defn- var-key [fnode] (str (get fnode :ns) "/" (get fnode :name))) @@ -463,81 +466,6 @@ ;; there are no false positives. The table is curated to genuinely-throwing ;; cases; lenient ops ((get 5 :k) -> nil, (:k 5) -> nil) are NOT listed. -;; concrete non-numbers: arithmetic provably throws on these. A union is in the -;; error domain only when EVERY member is — if any member is an -;; accepted type the call is accepted (no false positive). -(defn- not-number? [t] - (if (union-type? t) - (every? not-number? (umembers t)) - (or (= t :str) (= t :kw) (= t :phm) - (struct-type? t) (vec-type? t) (set-type? t)))) - -;; concrete non-seqable scalars: seq/count/first/nth provably throw on these. -;; (Strings and collections ARE seqable/countable; :truthy is ambiguous; :nil -;; and :any are accepted.) A union throws only when every member does. -(defn- not-seqable? [t] - (if (union-type? t) - (every? not-seqable? (umembers t)) - (or (= t :num) (= t :kw)))) - -;; concrete non-callable values: calling them throws "Cannot call X -;; as a function". Only :num and :str — keywords/maps/vectors/sets are IFn, -;; :truthy/:any/:nil are ambiguous (accepted). A union is non-callable only when -;; every member is. -(defn- not-callable? [t] - (if (union-type? t) - (every? not-callable? (umembers t)) - (or (= t :num) (= t :str)))) - -;; arithmetic / numeric ops: EVERY argument must be a number. -(def ^:private num-ops - #{"+" "-" "*" "/" "inc" "dec" "mod" "rem" "quot" "min" "max" "abs" - "bit-and" "bit-or" "bit-xor" "bit-not" "bit-shift-left" "bit-shift-right"}) -;; seq/count/index ops: argument 0 must be seqable/countable. -(def ^:private seq-ops #{"count" "first" "rest" "next" "seq" "nth"}) - -(defn- type-name - "Render an inferred type for an error message." - [t] - (cond (union-type? t) - (reduce (fn [s m] (if (= s "") (type-name m) (str s " or " (type-name m)))) - "" (umembers t)) - (struct-type? t) "a map" - (vec-type? t) "a vector" - (set-type? t) "a set" - (= t :str) "a string" - (= t :kw) "a keyword" - (= t :num) "a number" - (= t :phm) "a map" - :else (str t))) - -(defn- check-invoke - "If node is a core-op call whose argument type is provably in the error domain, - conj a diagnostic into env's diags cell. arg-types is the vector of inferred - argument types; pos is the call form's source offset, carried into each - diagnostic." - [cn args arg-types pos env] - (cond - (contains? num-ops cn) - (reduce (fn [_ i] - (let [t (nth arg-types i)] - (when (not-number? t) - (swap! (get env :diags) conj - {:op cn :argpos i :type (type-name t) :pos pos - :msg (str "`" cn "` requires a number, but argument " - (inc i) " is " (type-name t))}))) - nil) - nil (range (count args))) - (and (contains? seq-ops cn) (> (count args) 0)) - (let [t (nth arg-types 0)] - (when (not-seqable? t) - (swap! (get env :diags) conj - {:op cn :argpos 0 :type (type-name t) :pos pos - :msg (str "`" cn "` requires " - (if (= cn "count") "a countable collection" "a seqable") - ", but argument 1 is " (type-name t))}))) - :else nil)) - ;; --- user-function error domains, opt-in ------------------------------------- (defn- all-any-env "tenv binding every param name to :any (the all-ambiguous baseline)." @@ -554,24 +482,6 @@ (infer body tenv sub) (count @(get sub :diags)))) -(defn- register-user-fn! - "Record a (def name (fn [params] body)) — single fixed arity, not redefinable — - for later user-fn call checking. Redefinable/dynamic and multi/variadic fns are - skipped (their body is not a stable requirement)." - [node env] - (let [init (get node :init) - m (get node :meta) - redefable (and m (or (get m :redef) (get m :dynamic)))] - (when (and (not redefable) (= :fn (get init :op))) - (let [arities (get init :arities)] - (when (= 1 (count arities)) - (let [ar (first arities)] - (when (not (get ar :rest)) - (swap! (get env :user-sigs) assoc - (str (get node :ns) "/" (get node :name)) - {:name (get node :name) - :params (get ar :params) :body (get ar :body)})))))))) - (defn- check-user-call "Strict mode: report a call to a registered user fn that provably throws — either a WRONG ARITY (the registered fn has one fixed arity, so a different diff --git a/jolt-core/jolt/passes/types/check.clj b/jolt-core/jolt/passes/types/check.clj new file mode 100644 index 0000000..a6355d5 --- /dev/null +++ b/jolt-core/jolt/passes/types/check.clj @@ -0,0 +1,102 @@ +(ns jolt.passes.types.check + "Success-type error domains (RFC 0006): the curated tables of which concrete + types each core op provably throws on, the diagnostic emitter, and the user-fn + signature registry. Pure over inferred types plus the run's `env` cells — no + inference — so the inferencer (jolt.passes.types) and these rules can't perturb + each other. The inferencer calls these during its walk; the infer-coupled user + call probes (re-inference) stay in the inferencer." + (:require [jolt.passes.types.lattice :refer + [union-type? umembers struct-type? vec-type? set-type?]])) + +;; concrete non-numbers: arithmetic provably throws on these. A union is in the +;; error domain only when EVERY member is — if any member is an +;; accepted type the call is accepted (no false positive). +(defn- not-number? [t] + (if (union-type? t) + (every? not-number? (umembers t)) + (or (= t :str) (= t :kw) (= t :phm) + (struct-type? t) (vec-type? t) (set-type? t)))) + +;; concrete non-seqable scalars: seq/count/first/nth provably throw on these. +;; (Strings and collections ARE seqable/countable; :truthy is ambiguous; :nil +;; and :any are accepted.) A union throws only when every member does. +(defn- not-seqable? [t] + (if (union-type? t) + (every? not-seqable? (umembers t)) + (or (= t :num) (= t :kw)))) + +;; concrete non-callable values: calling them throws "Cannot call X +;; as a function". Only :num and :str — keywords/maps/vectors/sets are IFn, +;; :truthy/:any/:nil are ambiguous (accepted). A union is non-callable only when +;; every member is. +(defn not-callable? [t] + (if (union-type? t) + (every? not-callable? (umembers t)) + (or (= t :num) (= t :str)))) + +;; arithmetic / numeric ops: EVERY argument must be a number. +(def ^:private num-ops + #{"+" "-" "*" "/" "inc" "dec" "mod" "rem" "quot" "min" "max" "abs" + "bit-and" "bit-or" "bit-xor" "bit-not" "bit-shift-left" "bit-shift-right"}) +;; seq/count/index ops: argument 0 must be seqable/countable. +(def ^:private seq-ops #{"count" "first" "rest" "next" "seq" "nth"}) + +(defn type-name + "Render an inferred type for an error message." + [t] + (cond (union-type? t) + (reduce (fn [s m] (if (= s "") (type-name m) (str s " or " (type-name m)))) + "" (umembers t)) + (struct-type? t) "a map" + (vec-type? t) "a vector" + (set-type? t) "a set" + (= t :str) "a string" + (= t :kw) "a keyword" + (= t :num) "a number" + (= t :phm) "a map" + :else (str t))) + +(defn check-invoke + "If node is a core-op call whose argument type is provably in the error domain, + conj a diagnostic into env's diags cell. arg-types is the vector of inferred + argument types; pos is the call form's source offset, carried into each + diagnostic." + [cn args arg-types pos env] + (cond + (contains? num-ops cn) + (reduce (fn [_ i] + (let [t (nth arg-types i)] + (when (not-number? t) + (swap! (get env :diags) conj + {:op cn :argpos i :type (type-name t) :pos pos + :msg (str "`" cn "` requires a number, but argument " + (inc i) " is " (type-name t))}))) + nil) + nil (range (count args))) + (and (contains? seq-ops cn) (> (count args) 0)) + (let [t (nth arg-types 0)] + (when (not-seqable? t) + (swap! (get env :diags) conj + {:op cn :argpos 0 :type (type-name t) :pos pos + :msg (str "`" cn "` requires " + (if (= cn "count") "a countable collection" "a seqable") + ", but argument 1 is " (type-name t))}))) + :else nil)) + +(defn register-user-fn! + "Record a (def name (fn [params] body)) — single fixed arity, not redefinable — + for later user-fn call checking. Redefinable/dynamic and multi/variadic fns are + skipped (their body is not a stable requirement)." + [node env] + (let [init (get node :init) + m (get node :meta) + redefable (and m (or (get m :redef) (get m :dynamic)))] + (when (and (not redefable) (= :fn (get init :op))) + (let [arities (get init :arities)] + (when (= 1 (count arities)) + (let [ar (first arities)] + (when (not (get ar :rest)) + (swap! (get env :user-sigs) assoc + (str (get node :ns) "/" (get node :name)) + {:name (get node :name) + :params (get ar :params) :body (get ar :body)}))))))))