(ns com.tailrecursion.blacktide.machine-test
"Compile allocated machines with the real Clojure compiler and execute them."
(:require [clojure.test :refer [deftest is]]
[com.tailrecursion.blacktide.compiler.jvm :as jvm]
[com.tailrecursion.blacktide.compiler.passes.host-emit :as host]
[com.tailrecursion.blacktide.compiler.passes.emit :as emit]
[com.tailrecursion.blacktide.backend-fixture :refer [literal local assign put-value call block run-machine]]))
(deftest emission-is-complete-before-returning
(let [calls (atom []) original host/global-form
machine {:entry 0 :slots [] :live {}
:blocks (into {} (for [i (range 128)]
[i (block [(assign 'f {:op :global :name 'clojure.core/identity})]
{:op :return :value (literal i)})]))}
form (with-redefs [host/global-form (fn [name]
(swap! calls conj name)
(original name))]
(emit/program-form machine))]
(is (= (vec (repeat 128 'clojure.core/identity)) @calls))
(with-redefs [host/global-form (fn [_] (throw (ex-info "Deferred emission" {})))]
(is (string? (pr-str form)))
(is (zero? (eval form)))))
;; Emitting a quote must not realize its payload.
(let [payload (lazy-seq (throw (ex-info "Forced quoted data" {})))
form (emit/atom-form (literal payload))]
(is (identical? payload (second form)))))
(deftest values-and-clojure-truth
(doseq [value [nil false true 0 1N 1/2 2.5 2M "text" :keyword 'symbol [1 2] {:a 3} #{4}]]
(is (= value (run-machine {:entry 0 :slots [] :live {0 #{}}
:blocks {0 (block [] {:op :return :value (literal value)})}}))))
(doseq [condition [nil false true 0 "" []]]
(is (= (if condition :yes :no)
(run-machine {:entry 0 :slots [] :live {0 #{} 1 #{} 2 #{}}
:blocks {0 (block [] {:op :branch :test (literal condition) :yes 1 :no 2})
1 (block [] {:op :return :value (literal :yes)})
2 (block [] {:op :return :value (literal :no)})}})))))
(deftest label-values-and-exceptions
(doseq [label [0N 2147483648 Long/MAX_VALUE]]
(is (= :ok (run-machine {:entry label :slots [] :live {label #{}}
:blocks {label (block [] {:op :return :value (literal :ok)})}}))))
(let [machine {:entry 0 :slots [] :live {0 #{}}
:blocks {0 (block [(assign 'make-error {:op :global :name 'clojure.core/ex-info})
(call 'error 'make-error (literal "machine failure") (literal {:tag :expected}))]
{:op :throw :value (local 'error)})}}
error (try (run-machine machine) nil (catch clojure.lang.ExceptionInfo e e))]
(is (= {:tag :expected} (ex-data error)))
(is (= "machine failure" (ex-message error)))))
(deftest boxed-storage-and-native-calls
(doseq [value [nil false 3 2.5 1/2 "text"]]
(is (= value
(run-machine {:entry 0 :slots '[x] :live {0 #{} 1 '#{x}}
:blocks {0 (block [(put-value 'x value)] {:op :jump :target 1})
1 (block [(assign 'copy {:op :value :value (local 'x)})]
{:op :return :value (local 'copy)})}}))))
(let [machine {:entry 0 :slots ['x] :live {0 #{} 1 '#{x} 2 '#{x}}
:blocks {0 (block [(put-value 'x 1)] {:op :jump :target 1})
1 (block [(put-value 'x "changed")] {:op :jump :target 2})
2 (block [] {:op :return :value (local 'x)})}}]
(is (= "changed" (run-machine machine))))
(is (= [10 20]
(run-machine {:entry 0 :slots [] :live {0 #{}}
:blocks {0 (block [(assign 'f {:op :global :name 'clojure.core/vector})
(call 'value 'f (literal 10) (literal 20))]
{:op :return :value (local 'value)})}})))
(is (= #'clojure.core/vector
(run-machine {:entry 0 :slots [] :live {0 #{}}
:blocks {0 (block [(assign 'v {:op :var :name 'clojure.core/vector})]
{:op :return :value (local 'v)})}}))))
(deftest backedges-and-constant-stack
(let [machine {:entry 0 :slots '[case dec-fn zero-fn]
:live {0 #{} 1 '#{case dec-fn zero-fn} 2 '#{case dec-fn zero-fn} 3 '#{case}}
:blocks {0 (block [(put-value 'case 100000)
(assign 'dec-fn {:op :global :name 'clojure.core/dec})
(assign 'zero-fn {:op :global :name 'clojure.core/zero?})]
{:op :jump :target 1})
1 (block [(call 'done 'zero-fn (local 'case))]
{:op :branch :test (local 'done) :yes 3 :no 2})
2 (block [(call 'case 'dec-fn (local 'case))] {:op :jump :target 1})
3 (block [] {:op :return :value (local 'case)})}}]
(is (zero? (run-machine machine)))
(is (zero? (run-machine machine)))
(let [form (emit/program-form machine)
nodes (tree-seq #(and (coll? %) (not (and (seq? %) (= 'quote (first %))))) seq form)
operators (set (keep #(when (seq? %) (first %)) nodes))]
(is (= 'loop* (first form)))
(is (operators 'clojure.core/case))
(is (operators 'recur))
(is (not-any? operators '[atom volatile! object-array ref reset! swap! aset])))))
(defn record! [events tag value]
(swap! events conj tag)
value)
(deftest external-values-and-ordered-effects
(let [machine {:entry 0 :slots '[events f a]
:live {0 #{} 1 '#{events f a}}
:blocks {0 (block [(assign 'events {:op :external :name 'event-log :jvm (jvm/fact false {:hint nil :var-meta {}} :unknown)})
(assign 'f {:op :global :name 'com.tailrecursion.blacktide.machine-test/record!})
(call 'a 'f (local 'events) (literal :first) (literal 10))]
{:op :jump :target 1})
1 (block [(call 'b 'f (local 'events) (literal :second) (literal 20))]
{:op :return :value (local 'a)})}}
form (list 'let ['event-log '(atom []) 'value (emit/program-form machine)]
['value '(deref event-log)])]
(is (= [10 [:first :second]] (eval form)))))