(ns com.tailrecursion.blacktide.graph-test
"Graph invariants and executable allocation, independent of source lowering."
(:require [clojure.test :refer [deftest is]]
[clojure.test.check.clojure-test :refer [defspec]]
[clojure.test.check.generators :as gen]
[clojure.test.check.properties :as prop]
[com.tailrecursion.blacktide.compiler.passes.graph :as graph]
[com.tailrecursion.blacktide.backend-fixture :as m]))
(defn jump [target] {:op :jump :target target})
(defn result [value] {:op :return :value value})
(defn failure [program]
(try (graph/validate program) nil (catch clojure.lang.ExceptionInfo e (ex-data e))))
(deftest validate-destinations-before-reachability
(is (= {:kind :invalid-graph :block 0} (failure {:entry 0 :blocks {}})))
(is (= {:kind :invalid-graph :block 9 :target 10}
(failure {:entry 0 :blocks {0 (m/block [] (result (m/literal :ok)))
9 (m/block [] (jump 10))}}))))
(deftest initialization-is-path-sensitive
(doseq [program [{:entry 0 :blocks {0 (m/block [] (result (m/local 'x)))}}
{:entry 0 :blocks {0 (m/block [(m/assign 'x {:op :value :value (m/local 'x)})]
(result (m/local 'x)))}}
{:entry 0 :blocks {0 (m/block [] {:op :branch :test (m/literal true) :yes 1 :no 2})
1 (m/block [(m/put-value 'x 1)] (jump 3))
2 (m/block [] (jump 3))
3 (m/block [] (result (m/local 'x)))}}]]
(is (= :uninitialized-slot (:kind (failure program))))
(is (= '#{x} (:slots (failure program)))))
;; A definition after a read cannot initialize that read, even with a backedge.
(is (= :uninitialized-slot
(:kind (failure {:entry 0 :blocks {0 (m/block [(m/assign 'y {:op :value :value (m/local 'x)})
(m/put-value 'x 1)] (jump 0))}})))))
(deftest sequential-facts-and-opaque-payloads
(is (= {:reads '#{x} :defs '#{x y} :successors []}
(graph/block-facts
(m/block [(m/assign 'y {:op :value :value (m/local 'x)})
(m/put-value 'x 2)] (result (m/local 'y))))))
(let [data {:op :local :id 'ghost}
machine (m/checked-machine {:entry 0 :blocks {0 (m/block [(m/put-value 'x data)]
(result (m/local 'x)))
9 (m/block [] (result (m/local 'ghost)))}})]
(is (= #{0 9} (set (keys (:blocks machine)))))
(is (= '[ghost] (:slots machine)))
(is (= data (m/run-machine machine)))))
(deftest multiway-joins
(is (= :invalid-graph (:kind (failure {:entry 0 :blocks {0 (m/block [] {:op :switch :test (m/literal 0) :targets []})}}))))
(doseq [index (range 3)]
(let [program {:entry 0 :blocks {0 (m/block [] {:op :switch :test (m/literal index) :targets [1 2 3]})
1 (m/block [(m/put-value 'x :first)] (jump 4))
2 (m/block [(m/put-value 'x :middle)] (jump 4))
3 (m/block [(m/put-value 'x :last)] (jump 4))
4 (m/block [] (result (m/local 'x)))}}]
(is (= (nth [:first :middle :last] index) (m/run-machine (m/checked-machine program))))
(is (= :uninitialized-slot (:kind (failure (assoc-in program [:blocks 2 :ops] []))))))))
(deftest joins-and-live-value-survival
(doseq [test [true false]]
(let [machine (m/checked-machine
{:entry 0 :blocks {0 (m/block [(m/put-value 'x 10)
(m/assign 'saved {:op :value :value (m/local 'x)})]
{:op :branch :test (m/literal test) :yes 1 :no 2})
1 (m/block [(m/put-value 'x "new")] (jump 3))
2 (m/block [(m/put-value 'x 2.5)] (jump 3))
3 (m/block [(m/assign 'f {:op :global :name 'clojure.core/vector})
(m/call 'out 'f (m/local 'saved) (m/local 'x))]
(result (m/local 'out)))}})]
(is (= '[saved x] (:slots machine)))
(is (= '#{saved} (get (:live machine) 1)))
(is (= '#{saved x} (get (:live machine) 3)))
(is (= [10 (if test "new" 2.5)] (m/run-machine machine))))))
(defn step-value [value n] (if (odd? n) (+ value n) (- value n)))
(defn counting-graph [initial n]
{:entry 0
:blocks {0 (m/block [(m/put-value 'x initial) (m/put-value 'n n)
(m/assign 'step {:op :global :name 'com.tailrecursion.blacktide.graph-test/step-value})
(m/assign 'dec {:op :global :name 'clojure.core/dec})
(m/assign 'zero {:op :global :name 'clojure.core/zero?})]
(jump 1))
1 (m/block [(m/call 'done 'zero (m/local 'n))]
{:op :branch :test (m/local 'done) :yes 3 :no 2})
2 (m/block [(m/call 'x 'step (m/local 'x) (m/local 'n))
(m/call 'n 'dec (m/local 'n))] (jump 1))
3 (m/block [] (result (m/local 'x)))}})
(defn rename-blocks [program]
(let [rename #(+ 100 (* 7 %))]
{:entry (rename (:entry program))
:blocks (into {} (map (fn [[id block]]
[(rename id)
(update block :term
(fn [term]
(case (:op term)
:jump (update term :target rename)
:branch (-> term (update :yes rename) (update :no rename))
term)))])) (:blocks program))}))
(defspec deterministic-backedges-and-metamorphisms {:num-tests 75 :seed 8675309}
(prop/for-all [initial (gen/choose -100 99) n (gen/choose 0 29)]
(let [expected (+ initial (reduce + 0 (map #(if (odd? %) % (- %)) (range 1 (inc n)))))
program (counting-graph initial n)]
(every? true?
(for [variant [program (rename-blocks program)
(assoc-in program [:blocks 99] (m/block [] (result (m/local 'uninitialized))))]]
(= expected (m/run-machine (m/checked-machine variant))))))))