;; BAKING (defn fib (n) (if (< n 2) 1 (+ (fib (- n 2)) (fib (- n 1))))) (defn test-fib () (do (bake fib) (assert-eq (fib 6) 13) (assert-eq (type fib) :foreign) :fib-is-ok)) (test-fib) (defn foo [x] (+ (- (fib x) 100) 7)) (defn test-foo () (do (bake* foo '(fib)) (assert-eq (foo 6) -80) (assert-eq (type foo) :foreign) :foo-is-ok)) (test-foo) (defn hypo [x y] (sqrtf (+ (* x x) (* y y)))) (defn test-hypo () (do (bake hypo) (assert-approx-eq (hypo 3.0f 4.0f) 5.0f) (assert-eq (type hypo) :foreign) :hypo-is-ok)) (test-hypo) (defn f [s] (strlen s)) (defn g (x s) (* x (f s))) (defn h (x) (if false "Hej" x)) (def fast (lambda-to-ast (code f))) (def fcon (gencon fast)) (def fasta (annotate-ast fast)) (def hast (lambda-to-ast (code h))) (def hcon (gencon hast)) (def hasta (annotate-ast hast)) (defn fail-1 () (+ "hej" 23)) (def fail-1-ast (lambda-to-ast (code fail-1))) (def fail-1-con (gencon fail-1-ast)) ;;(def fail-1-asta (annotate-ast fail-1-ast)) (defn mix (x y z) (if (< (strlen z) 3) (* (itof y) x) x)) ;; (def mixast (lambda-to-ast (code mix))) ;; (def mixcon (gencon mixast)) ;; (def mixasta (annotate-ast mixast)) (defn monad () (do (strlen "hej") (strlen "svej") (strlen "yay"))) (def monast (lambda-to-ast (code monad))) (def moncon (gencon monast)) (def monasta (annotate-ast monast)) (defn test-loading () (do (save "out/out.c" "int f() { return 100; }") (system "clang -shared -o out/f.so out/out.c") (def flib (load-dylib "out/f.so")) (register flib "f" () :int) (assert-eq 100 (f)) (save "out/out.c" "int g() { return 150; }") (system "clang -shared -o out/g.so out/out.c") (def glib (load-dylib "out/g.so")) (register glib "g" () :int) (assert-eq 150 (g)) (unload-dylib flib) (save "out/out.c" "int f() { return 200; }") (system "clang -shared -o out/f.so out/out.c") (def flib (load-dylib "out/f.so")) (register flib "f" () :int) (assert-eq 200 (f)) )) ;; This does NOT work! (defn shadow (x) (let [x (* x 3)] x)) ;; (def shadowast (lambda-to-ast (code shadow))) ;; (def shadowcon (gencon shadowast)) ;; (def shadowasta (annotate-ast shadowast)) (defn non-baked (x) (* x 10)) (defn deps-1 () (non-baked 3)) (def deps-1-ast (lambda-to-ast (code deps-1))) (def deps-1-deps (find-func-deps deps-1-ast true)) (def deps-1-con (gencon deps-1-ast)) (def deps-1-asta (annotate-ast deps-1-ast)) ;; Auto chain bake (defn test-auto-chain-bake-1 () (do (defn f1 () 100) (defn f2 () 200) (defn f3 () (+ (f1) (f2))) (bake f3) (assert-eq (f3) 300))) (test-auto-chain-bake-1) (defn test-auto-chain-bake-2 () (do (defn f4 () 100) (defn f5 (x) (+ x 1)) (defn f6 () (let [z (f5 (f4))] z)) (bake f6) (assert-eq (f6) 101))) (test-auto-chain-bake-2) (defn test-unloading-depending-functions [] (do (defn f7 [] 100) (bake f7) (assert-eq 100 (f7)) (defn f8 [] (f7)) (bake f8) (assert-eq 100 (f8)) (defn f9 [] (f7)) (bake f9) (assert-eq 100 (f9)) (defn f10 [] (f9)) (bake f10) (assert-eq 100 (f10)) (defn f7 [] 200) (bake f7) (assert-eq 200 (f7)) (assert-eq 200 (f8)) (assert-eq 200 (f9)) (assert-eq 200 (f10)) )) (test-unloading-depending-functions) ;; COMPILE TIME MACROS (defn macro-1 () (if-not true 10 20)) (defn test-macro-1 () (do (bake macro-1) (assert-eq (macro-1) 20))) (test-macro-1) ;; RESET (defn reset-1 () (let [x 0] (do (reset! x 123) x))) (defn test-reset-1 () (do (bake reset-1) (assert-eq (reset-1) 123))) ;;(test-reset-1) (def reset-1-ast (lambda-to-ast (code reset-1))) (def reset-1-deps (find-func-deps reset-1-ast false)) (def reset-1-con (gencon reset-1-ast)) (def reset-1-asta (annotate-ast reset-1-ast)) ;; LET BINDINGS (defn recursive-let () (let [;; The other definition order should get caught by compiler, not clang: y "whaaaaaaat" x (string-append "hej" (ref (itos (strlen y)))) ] x)) (bake recursive-let) ;; FUNCTION POINTERS (defn call-twice (f) (do (strlen (ref (f))) (f))) (def twice-ast (lambda-to-ast (code call-twice))) (def twice-deps (find-func-deps twice-ast false)) (def twice-con (gencon twice-ast)) (def twice-asta (annotate-ast twice-ast)) (defn call-me () (string-copy "CARP!")) (defn test-call-twice () (do (bake call-twice) (bake call-me) (assert-eq "CARP!" (call-twice call-me)))) (test-call-twice) ;; CHARS (defn gimme-char () \e)