mirror of
https://github.com/carp-lang/Carp.git
synced 2024-10-12 04:58:18 +03:00
245 lines
4.5 KiB
Plaintext
245 lines
4.5 KiB
Plaintext
;; 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.0 4.0) 5.0)
|
|
(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)
|
|
|