Carp/lisp/baking_tests.carp

;; 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)