Add codegen for storage class specifiers

Switch map/filter to eager versions

5 files changed, 120 insertions, 66 deletions

diff --git a/src/cljcc/compiler.clj b/src/cljcc/compiler.clj
index 17da6cf..d40bc4b 100644
--- a/src/cljcc/compiler.clj
+++ b/src/cljcc/compiler.clj
@@ -3,7 +3,8 @@
             [clojure.pprint :as pp]
             [cljcc.tacky :as t]
             [cljcc.lexer :as l]
-            [cljcc.analyzer :as a]))
+            [cljcc.analyzer :as a]
+            [cljcc.exception :as exc]))
 
 (def registers #{:ax :dx :di :si :r8 :r9 :r10 :r11 :cx :cl})
 
@@ -103,6 +104,16 @@
    :operand-type :pseudo
    :identifier identifier})
 
+(defn- data-operand [identifier]
+  {:operand :data
+   :operand-type :data
+   :identifier identifier})
+
+(defn- memory-address? [operand]
+  (or (contains? #{:data :stack} operand) ;; TODO: remove this check once refactored
+      (contains? #{:data :stack} (:operand operand))
+      (contains? #{:data :stack} (:operand-type operand))))
+
 ;;;; Tacky -> Instructions
 
 (defn- tacky-val->assembly-operand [{:keys [type value]}]
@@ -196,7 +207,7 @@
     (->> register-args
          (interleave argument-passing-registers)
          (partition 2)
-         (map arg-mov-instruction)
+         (mapv arg-mov-instruction)
          flatten)))
 
 (defn- pass-args-on-stack-instructions
@@ -214,7 +225,7 @@
                                    (push-instruction (reg-operand :ax))])))]
     (->> stack-args
          reverse
-         (map arg-mov-instruction)
+         (mapv arg-mov-instruction)
          flatten
          (remove nil?))))
 
@@ -253,7 +264,7 @@
   (let [transformer-fn ((:type inst) tacky->assembly-transformers)]
     (transformer-fn inst)))
 
-(defn- find-pseudo-values
+(defn- find-pseudo-identifiers
   "Returns list of identifiers for pseudo operands.
 
   Drills into each instruction. Collects identifier from any pseudo operand."
@@ -270,16 +281,16 @@
                                       []
                                       operand-keys-in-instruction))]
     (->> instructions
-         (map instruction->pseudo-values)
+         (mapv instruction->pseudo-values)
          flatten
          (remove nil?)
          distinct)))
 
-(defn- create-pseudo-value-map
-  "Returns a map from pseudo identifiers.
+(defn- pseudo-identifier-to-stack-address
+  "Returns a map from pseudo identifiers to stack address in memory.
 
-  Assigns each identifier values, corresponding to memory addresses in stack."
-  [pseudo-values]
+  Assigns each identifier subsequent lower memory addresses in stack."
+  [pseudo-identifiers]
   (reduce
    (fn [acc cur]
      (let [exists? (contains? acc cur)
@@ -288,26 +299,45 @@
          acc
          (assoc acc cur (- v 4) "current" (- v 4)))))
    {"current" 0}
-   pseudo-values))
+   pseudo-identifiers))
+
+(defn- pseudo->data-operand-instruction [ident->symbol instruction]
+  (let [pseudo-data-operand? (fn [inst path]
+                               (let [operand (get-in inst [path])
+                                     operand-type (:operand-type operand)
+                                     identifier (:identifier operand)]
+                                (and
+                                 (= :pseudo operand-type)
+                                 (contains? ident->symbol identifier)
+                                 (= :static (get-in ident->symbol [identifier :attrs :type])))))
+        replace-pseudo-with-data-op (fn [inst path]
+                                      (if (pseudo-data-operand? inst path)
+                                        (assoc inst path (data-operand (get-in inst [path :identifier])))
+                                        inst))]
+    (-> instruction
+        (replace-pseudo-with-data-op :src)
+        (replace-pseudo-with-data-op :dst)
+        (replace-pseudo-with-data-op :operand))))
 
-(defn- pseudo->stack-operand-instruction [pseudo-value->stack-value instruction]
+(defn- pseudo->stack-operand-instruction [pseudo-ident->stack-address instruction]
   (let [pseudo-operand? (fn [inst path] (= :pseudo (get-in inst [path :operand-type])))
-        replace-pseudo (fn [inst path]
-                         (if (pseudo-operand? inst path)
-                           (let [v (get-in inst [path :identifier])
-                                 sv (get pseudo-value->stack-value v)]
-                             (assoc inst path (stack-operand sv)))
-                           inst))]
+        replace-pseudo-with-stack-op (fn [inst path]
+                                       (if (pseudo-operand? inst path)
+                                         (let [v (get-in inst [path :identifier])
+                                               sv (get pseudo-ident->stack-address v)]
+                                           (assoc inst path (stack-operand sv)))
+                                         inst))]
     (-> instruction
-        (replace-pseudo :src)
-        (replace-pseudo :dst)
-        (replace-pseudo :operand))))
+        (replace-pseudo-with-stack-op :src)
+        (replace-pseudo-with-stack-op :dst)
+        (replace-pseudo-with-stack-op :operand))))
 
-(defn- replace-pseudoregisters [instructions]
-  (let [pseudo-values (find-pseudo-values instructions)
-        pseudo-value-map (create-pseudo-value-map pseudo-values)]
-    {:max-stack-val  (get pseudo-value-map "current")
-     :instructions (map #(pseudo->stack-operand-instruction pseudo-value-map %) instructions)}))
+(defn- replace-pseudoregisters [instructions ident->symbol]
+  (let [instructions-with-data-ops (mapv #(pseudo->data-operand-instruction ident->symbol %) instructions)
+        pseudo-identifiers (find-pseudo-identifiers instructions-with-data-ops)
+        pseudo-ident->stack-address (pseudo-identifier-to-stack-address pseudo-identifiers)]
+    {:max-stack-val  (get pseudo-ident->stack-address "current")
+     :instructions (mapv #(pseudo->stack-operand-instruction pseudo-ident->stack-address %) instructions-with-data-ops)}))
 
 (defn- fix-binary-instruction [instruction]
   (let [binop (:binary-operator instruction)
@@ -315,15 +345,15 @@
         dst (:dst instruction)
         mul? (= binop :mul)]
     (if mul?
-      (let [dst-memory-address? (= :stack (:operand dst))]
+      (let [dst-memory-address? (memory-address? dst)]
         (if dst-memory-address?
           [(mov-instruction dst (reg-operand :r11))
            (binary-instruction binop src (reg-operand :r11))
            (mov-instruction (reg-operand :r11) dst)]
           instruction))
       (let [both-memory-address? (and
-                                  (= :stack (:operand src))
-                                  (= :stack (:operand dst)))]
+                                  (memory-address? src)
+                                  (memory-address? dst))]
         (if both-memory-address?
           [(mov-instruction src (reg-operand :r10))
            (binary-instruction binop (reg-operand :r10) dst)]
@@ -331,8 +361,8 @@
 
 (defn- fix-mov-instruction [instruction]
   (let [both-memory-address? (and
-                              (= :stack (get-in instruction [:src :operand]))
-                              (= :stack (get-in instruction [:dst :operand])))]
+                              (memory-address? (:src instruction))
+                              (memory-address? (:dst instruction)))]
     (if both-memory-address?
       [(mov-instruction (get instruction :src) (reg-operand :r10))
        (mov-instruction (reg-operand :r10) (get instruction :dst))]
@@ -346,8 +376,8 @@
 
 (defn- fix-cmp-instruction [instruction]
   (let [both-memory-address? (and
-                              (= :stack (get-in instruction [:src :operand]))
-                              (= :stack (get-in instruction [:dst :operand])))
+                              (memory-address? (:src instruction))
+                              (memory-address? (:dst instruction)))
         dst-constant? (= :imm (get-in instruction [:dst :operand]))]
     (cond
       both-memory-address? [(mov-instruction (get instruction :src) (reg-operand :r10))
@@ -387,32 +417,49 @@
   [parameters]
   (let [registers [:di :si :dx :cx :r8 :r9]
         [register-params stack-params] (split-at 6 parameters)
-        reg-args-to-pseudo-instructions (map (fn [reg param]
-                                               [(mov-instruction (reg-operand reg) (pseudo-operand (:identifier param)))])
+        reg-args-to-pseudo-instructions (mapv (fn [reg param]
+                                                [(mov-instruction (reg-operand reg) (pseudo-operand (:identifier param)))])
                                              registers
                                              register-params)
-        stack-args-to-pseudo-instruction (map-indexed (fn [idx param]
-                                                        [(mov-instruction (stack-operand (+ 16 (* 8 idx))) (pseudo-operand (:identifier param)))]) stack-params)]
+        stack-args-to-pseudo-instruction (into [] (map-indexed (fn [idx param]
+                                                                 [(mov-instruction (stack-operand (+ 16 (* 8 idx))) (pseudo-operand (:identifier param)))]) stack-params))]
     (->> [reg-args-to-pseudo-instructions stack-args-to-pseudo-instruction]
          flatten
          (remove nil?))))
 
-(defn- tacky-function->assembly-function [{:keys [type identifier parameters instructions]}]
+(defn- tacky-function->assembly-function
+  [{:keys [global? identifier parameters instructions declaration-type]} ident->symbol]
   (let [parameter-instructions (parameters->assembly-instructions parameters)
         body-instructions (->> instructions
                                (keep tacky-inst->assembly-inst)
                                flatten)]
-    {:op type
+    {:op :function
+     :type declaration-type
      :identifier identifier
+     :global? global?
      :instructions (->> [parameter-instructions body-instructions]
                         flatten
-                        replace-pseudoregisters
+                        ((fn [is] (replace-pseudoregisters is ident->symbol)))
                         add-allocate-stack-instruction
                         (keep fix-instruction)
                         flatten)}))
 
-(defn- tacky-ast->assembly [ast]
-  (map tacky-function->assembly-function ast))
+(defn- tacky-static-variable->assembly-static-variable
+  [{:keys [identifier initial-value global? declaration-type]}]
+  {:op :static-variable
+   :type declaration-type
+   :global? global?
+   :identifier identifier
+   :initial-value initial-value})
+
+(defn- tacky-top-level->assembly [top-level ident->symbol]
+  (condp = (:declaration-type top-level)
+    :function (tacky-function->assembly-function top-level ident->symbol)
+    :static-variable (tacky-static-variable->assembly-static-variable top-level)
+    (exc/compiler-error "Invalid tacky type passed to compiler." top-level)))
+
+(defn- tacky-ast->assembly [{:keys [program ident->symbol]}]
+  (mapv #(tacky-top-level->assembly % ident->symbol) program))
 
 (defn generate-assembly [source]
   (-> source
@@ -426,13 +473,10 @@
 
   (generate-assembly
    "
-int foo(int a) {
-    return a + 1;
-}
+extern int x = 10;
 
 int main (void) {
-    int y = 5;
-    int x = foo(10);
+    int y = x + 100;
     return x;
 }
 
diff --git a/src/cljcc/emit.clj b/src/cljcc/emit.clj
index 1d8c51a..866fe91 100644
--- a/src/cljcc/emit.clj
+++ b/src/cljcc/emit.clj
@@ -199,28 +199,31 @@
               "    movq        %rsp, %rbp"
               instructions])))
 
+(defn- static-variable-definition-emit [{:keys [identifier global? initial-value]}])
+
 (def emitters-top-level
   "Map of assembly top level constructs to their emitters."
-  {:declaration #'function-definition-emit})
+  {:function #'function-definition-emit
+   :static-variable #'static-variable-definition-emit})
 
-(defn emit-top-level [assembly-ast]
-  (if-let [[_ emit-fn] (find emitters-top-level (:op assembly-ast))]
-    (emit-fn assembly-ast)
-    (throw (AssertionError. (str "Invalid ast: " assembly-ast)))))
+(defn emit-top-level [tacky-ast]
+  (if-let [[_ emit-fn] (find emitters-top-level (:type tacky-ast))]
+    (emit-fn tacky-ast)
+    (throw (AssertionError. (str "Invalid ast: " tacky-ast)))))
 
 (def linux-assembly-end ".section .note.GNU-stack,\"\",@progbits")
 
-(defn emit [ast]
+(defn emit [top-levels]
   (let [handle-os (fn [ast]
                     (if (= :linux (get-os))
                       (conj (conj (vec ast) linux-assembly-end) "\n")
                       (conj ast "\n")))]
-    (->> ast
+    (->> top-levels
          (map emit-top-level)
          concat
          flatten
          handle-os
-         (str/join "\n"))))
+         (str/join "\n\n"))))
 
 (comment
 
diff --git a/src/cljcc/exception.clj b/src/cljcc/exception.clj
index 9ea5f31..bf98ed4 100644
--- a/src/cljcc/exception.clj
+++ b/src/cljcc/exception.clj
@@ -10,3 +10,6 @@
 
 (defn analyzer-error [msg data]
   (throw (ex-info msg (merge {:error/type :analyzer} data))))
+
+(defn compiler-error [msg data]
+  (throw (ex-info msg (merge {:error/type :compiler} data))))
diff --git a/src/cljcc/log.clj b/src/cljcc/log.clj
index 394e4a4..3dbc4fb 100644
--- a/src/cljcc/log.clj
+++ b/src/cljcc/log.clj
@@ -1,6 +1,5 @@
 (ns cljcc.log
-  (:require [clojure.string :as str]
-            [cljcc.log :as log]))
+  (:require [clojure.string :as str]))
 
 (def ^:private log-colors
   {:debug "\u001b[36m" ; Cyan
diff --git a/src/cljcc/tacky.clj b/src/cljcc/tacky.clj
index 6f5b6de..d864f69 100644
--- a/src/cljcc/tacky.clj
+++ b/src/cljcc/tacky.clj
@@ -223,11 +223,11 @@
                      (label-instruction end-label)])}))
 
 (defn- function-call-exp-handler [{identifier :identifier arguments :arguments}]
-  (let [arg-exps (map expression-handler arguments)
+  (let [arg-exps (mapv expression-handler arguments)
         dst (variable (str "function_call_result_" identifier))
-        fn-instruction (fun-call-instruction identifier (map #(:val %) arg-exps) dst)]
+        fn-instruction (fun-call-instruction identifier (mapv #(:val %) arg-exps) dst)]
     {:val dst
-     :instructions (flatten [(map #(:instructions %) arg-exps) fn-instruction])}))
+     :instructions (flatten [(mapv #(:instructions %) arg-exps) fn-instruction])}))
 
 (defn- expression-handler [e]
   (when-let [exp-type (:exp-type e)]
@@ -272,7 +272,7 @@
        (label-instruction end-label)])))
 
 (defn- compound-statement-handler [s]
-  (flatten (map block-item->tacky-instruction (:block s))))
+  (flatten (mapv block-item->tacky-instruction (:block s))))
 
 (defn- break-statement-handler [s]
   [(jump-instruction (str "break_" (:label s)))])
@@ -372,7 +372,7 @@
         instructions (->> function-definition
                           :body
                           (remove nil?)
-                          (map block-item->tacky-instruction)
+                          (mapv block-item->tacky-instruction)
                           flatten
                           (remove nil?)
                           add-return)]
@@ -409,14 +409,15 @@
                               (or (= (:identifier x) "main") (seq (:body x)))
                               true))]
     (->> ast
-         (filter #(= :function (:declaration-type %)))
-         (filter fn-defined?)
-         (map #(function-definition->tacky-function % ident->symbol)))))
+         (filterv #(= :function (:declaration-type %)))
+         (filterv fn-defined?)
+         (mapv #(function-definition->tacky-function % ident->symbol)))))
 
 (defn tacky-generate [{ast :block ident->symbol :ident->symbol}]
   (let [variable-instructions (tacky-static-variable-instructions ident->symbol)
         function-instructions (tacky-function-instructions ast ident->symbol)]
-    (concat variable-instructions function-instructions)))
+    {:program (concat variable-instructions function-instructions)
+     :ident->symbol ident->symbol}))
 
 (defn tacky-from-src [src]
   (-> src
@@ -431,8 +432,12 @@
    "
 static int x;
 
+extern int y = 100;
+
 int foo(int a) {
-return a + 1;
+int b = a;
+int z = 78 - 1;
+return z;
 }
 
 ")