git » blacktide.git » master » tree

[master] / src / com / tailrecursion / blacktide / compiler / passes / case_emit.clj 

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
(ns ^:typed.clojure com.tailrecursion.blacktide.compiler.passes.case-emit
  "Emit native case* dispatch from constant table data. Result arms are separate
  from constant matching; selection never substitutes ordinary equality for case."
  (:require [com.tailrecursion.nanopass :as np]
            [com.tailrecursion.blacktide.compiler.languages :as l]
            [typed.clojure :as-alias t]))

(np/defpass selector-form
  {:from [l/Bound CaseSpec] :to [l/Machine Code] :args [l/Machine-Code] :body true}
  [value spec]
  (let [local (gensym "dispatch__")]
    (list 'let* [local value]
          (list 'case* local (:shift spec) (:mask spec) (:default spec)
                (into (sorted-map) (:tests spec)) (:switch spec) (:test spec) (:skip spec)))))

(np/defpass arms-form
  {:from [l/Machine Code] :to [l/Machine Code] :args [(t/Vec l/Machine-Code)] :body true}
  [arms selector]
  (let [local (gensym "selected__")
        default (or (first arms) (throw (IllegalStateException. "Case requires an arm")))
        table (into (sorted-map) (map-indexed (fn [index arm] [index [index arm]]) arms))]
    ;; The selector is exhaustive. Reusing an arm as the unreachable default
    ;; preserves native common-return typing without introducing a nil arm.
    (list 'let* [local selector] (list 'case* local 0 0 default table :compact :int))))