Refactor files to cljcc-compiler and cli tool.

4 files changed, 952 insertions, 0 deletions

diff --git a/cljcc-compiler/src/cljcc/analyze/core.clj b/cljcc-compiler/src/cljcc/analyze/core.clj
new file mode 100644
index 0000000..793b667
--- /dev/null
+++ b/cljcc-compiler/src/cljcc/analyze/core.clj
@@ -0,0 +1,10 @@
+(ns cljcc.analyze.core
+  (:require [cljcc.analyze.resolve :as r]
+            [cljcc.analyze.label-loops :as l]
+            [cljcc.analyze.typecheck :as t]))
+
+(defn validate [program]
+  (-> program
+      r/resolve-program
+      l/label-loops
+      t/typecheck))
diff --git a/cljcc-compiler/src/cljcc/analyze/label_loops.clj b/cljcc-compiler/src/cljcc/analyze/label_loops.clj
new file mode 100644
index 0000000..56fffc9
--- /dev/null
+++ b/cljcc-compiler/src/cljcc/analyze/label_loops.clj
@@ -0,0 +1,105 @@
+(ns cljcc.analyze.label-loops
+  (:require [cljcc.parser :as p]
+            [cljcc.exception :as exc]
+            [cljcc.analyze.resolve :as r]
+            [cljcc.schema :as s]
+            [cljcc.util :as util]
+            [malli.dev.pretty :as pretty]))
+
+(defn- unique-identifier [identifier]
+  (util/create-identifier! identifier))
+
+(defn- annotate-label [m label]
+  (assoc m :label label))
+
+(defn- label-statement
+  ([s]
+   (label-statement s nil))
+  ([{:keys [statement-type] :as s} current-label]
+   (condp = statement-type
+     :break (if (nil? current-label)
+              (exc/analyzer-error "break statement outside of loop" s)
+              (p/break-statement-node current-label))
+     :continue (if (nil? current-label)
+                 (exc/analyzer-error "continue statement outside of loop" s)
+                 (p/continue-statement-node current-label))
+     :while (let [new-label (unique-identifier "while_label")
+                  l-body (label-statement (:body s) new-label)
+                  l-while  (p/while-statement-node (:condition s) l-body)]
+              (annotate-label l-while new-label))
+     :do-while (let [new-label (unique-identifier "do_while_label")
+                     l-body (label-statement (:body s) new-label)
+                     l-do-while (p/do-while-statement-node (:condition s) l-body)]
+                 (annotate-label l-do-while new-label))
+     :for (let [new-label (unique-identifier "for_label")
+                l-body (label-statement (:body s) new-label)
+                l-for (p/for-statement-node (:init s) (:condition s) (:post s) l-body)]
+            (annotate-label l-for new-label))
+     :if (if (:else-statement s)
+           (p/if-statement-node (:condition s)
+                                (label-statement (:then-statement s) current-label)
+                                (label-statement (:else-statement s) current-label))
+           (p/if-statement-node (:condition s)
+                                (label-statement (:then-statement s) current-label)))
+     :compound (let [update-block-f (fn [item]
+                                      (if (= (:type item) :statement)
+                                        (label-statement item current-label)
+                                        item))
+                     new-block (mapv update-block-f (:block s))]
+                 (p/compound-statement-node new-block))
+     :return s
+     :expression s
+     :empty s
+     (exc/analyzer-error "invalid statement reached during loop labelling." s))))
+
+(defn- label-loop-function-body [fn-declaration]
+  (let [statement? (fn [x] (= :statement (:type x)))
+        labelled-body (mapv (fn [block-item]
+                              (if (statement? block-item)
+                                (label-statement block-item)
+                                block-item))
+                            (:body fn-declaration))]
+    (assoc fn-declaration :body labelled-body)))
+
+(defn label-loops
+  "Annotates labels on looping constructs.
+
+  Parameter:
+    program: List of declarations / blocks"
+  [program]
+  (let [fn-declaration? (fn [x] (= :function (:declaration-type x)))]
+    (mapv (fn [block]
+            (if (fn-declaration? block)
+              (label-loop-function-body block)
+              block))
+          program)))
+
+(comment
+
+  (-> "./test-programs/example.c"
+      slurp
+      p/parse-from-src
+      r/resolve-program)
+
+  (-> "./test-programs/example.c"
+      slurp
+      p/parse-from-src
+      r/resolve-program
+      label-loops)
+
+  (pretty/explain
+   s/Program
+   (-> "./test-programs/example.c"
+       slurp
+       p/parse-from-src
+       r/resolve-program))
+
+  (pretty/explain
+   s/Program
+   (-> "./test-programs/example.c"
+       slurp
+       p/parse-from-src
+       r/resolve-program
+       label-loops))
+
+  ())
diff --git a/cljcc-compiler/src/cljcc/analyze/resolve.clj b/cljcc-compiler/src/cljcc/analyze/resolve.clj
new file mode 100644
index 0000000..9f09333
--- /dev/null
+++ b/cljcc-compiler/src/cljcc/analyze/resolve.clj
@@ -0,0 +1,300 @@
+(ns cljcc.analyze.resolve
+  (:require [cljcc.exception :as exc]
+            [cljcc.parser :as p]
+            [malli.dev.pretty :as pretty]
+            [cljcc.schema :as s]
+            [cljcc.util :as util]
+            [malli.core :as m]))
+
+(defn- unique-identifier [identifier]
+  (util/create-identifier! identifier))
+
+(defn- copy-identifier-map
+  "Returns a copy of the identifier -> symbol map.
+
+  Sets :at-top-level false, as it's going inside a scope. ( Could be fn definition, compound statement ).
+  Sets :from-current-scope as false for every symbol. Used when going into a inner scope."
+  [ident->symbol]
+  (let [set-from-current-scope-as-false (fn [i->s]
+                                          (zipmap (keys i->s)
+                                                  (map (fn [s]
+                                                         (assoc s :from-current-scope false))
+                                                       (vals i->s))))]
+    (-> ident->symbol
+        (dissoc :at-top-level)
+        set-from-current-scope-as-false
+        (assoc :at-top-level false))))
+
+(declare resolve-block resolve-declaration resolve-optional-exp)
+
+(defn- resolve-exp [e ident->symbol]
+  (condp = (:exp-type e)
+    :constant-exp e
+    :variable-exp (if (contains? ident->symbol (:identifier e))
+                    (p/variable-exp-node (:name (get ident->symbol (:identifier e))))
+                    (exc/analyzer-error "Undeclared variable seen." {:variable e}))
+    :assignment-exp (let [left (:left e)
+                          right (:right e)
+                          op (:assignment-operator e)
+                          left-var? (= :variable-exp (:exp-type left))]
+                      (if left-var?
+                        (p/assignment-exp-node (resolve-exp left ident->symbol)
+                                               (resolve-exp right ident->symbol)
+                                               op)
+                        (exc/analyzer-error "Invalid lvalue in assignment expression." {:lvalue e})))
+    :binary-exp (p/binary-exp-node (resolve-exp (:left e) ident->symbol)
+                                   (resolve-exp (:right e) ident->symbol)
+                                   (:binary-operator e))
+    :unary-exp (p/unary-exp-node (:unary-operator e) (resolve-exp (:value e) ident->symbol))
+    :conditional-exp (p/conditional-exp-node (resolve-exp (:left e) ident->symbol)
+                                             (resolve-exp (:middle e) ident->symbol)
+                                             (resolve-exp (:right e) ident->symbol))
+    :cast-exp (p/cast-exp-node (:target-type e)
+                               (resolve-exp (:value e) ident->symbol))
+    :function-call-exp (let [fn-name (:identifier e)
+                             args (:arguments e)]
+                         (if (contains? ident->symbol fn-name)
+                           (p/function-call-exp-node (:new-name (get ident->symbol fn-name))
+                                                     (mapv #(resolve-exp % ident->symbol) args))
+                           (exc/analyzer-error "Undeclared function." {:function-name fn-name})))
+    (exc/analyzer-error "Invalid expression." {:exp e})))
+
+(defn- resolve-optional-exp [e ident->symbol]
+  (if (nil? e)
+    e
+    (resolve-exp e ident->symbol)))
+
+(defn- resolve-file-scope-variable-declaration
+  "Adds file scope variable declaration to scope.
+
+  Directly adds variable declaration to map as it is top level."
+  [{:keys [identifier] :as declaration} ident->symbol]
+  {:declaration declaration
+   :ident->symbol (assoc ident->symbol identifier {:new-name identifier
+                                                   :name identifier
+                                                   :from-current-scope true
+                                                   :has-linkage true})})
+
+(defn- resolve-local-variable-declaration
+  "Add local variable declaration.
+
+  Validates for variables declared with same name.
+  Validates for variables declared from different scope, but with conflicting storage class."
+  [{:keys [identifier initial variable-type storage-class] :as declaration} ident->symbol]
+  (let [prev-entry (get ident->symbol identifier)
+        extern? (= storage-class :extern)
+        _ (when (and prev-entry (:from-current-scope prev-entry))
+            (when (not (and (:has-linkage prev-entry) extern?))
+              (exc/analyzer-error "Conflicting local declaration." {:declaration declaration})))]
+    (if extern?
+      {:declaration declaration
+       :ident->symbol (assoc ident->symbol identifier {:new-name identifier
+                                                       :name identifier
+                                                       :from-current-scope true
+                                                       :has-linkage true})}
+      (let [unique-name (unique-identifier identifier)
+            updated-symbols (assoc ident->symbol identifier {:new-name unique-name
+                                                             :name unique-name
+                                                             :from-current-scope true
+                                                             :has-linkage false})
+            init-value (when initial (resolve-exp initial updated-symbols))]
+        {:declaration (p/variable-declaration-node unique-name storage-class variable-type init-value)
+         :ident->symbol updated-symbols}))))
+
+(defn- resolve-variable-declaration
+  "Resolves variable declarations.
+
+  Ensures variable not declared twice in the current scope."
+  [decl {:keys [at-top-level] :as ident->symbol}]
+  (if at-top-level
+    (resolve-file-scope-variable-declaration decl ident->symbol)
+    (resolve-local-variable-declaration decl ident->symbol)))
+
+(defn- resolve-parameter [parameter ident->symbol]
+  (if (and (contains? ident->symbol parameter)
+           (:from-current-scope (get ident->symbol parameter)))
+    (exc/analyzer-error "Parameter name duplicated." {:parameter parameter})
+    (let [unique-name (unique-identifier parameter)
+          updated-identifier-map (assoc ident->symbol parameter {:name unique-name
+                                                                 :from-current-scope true
+                                                                 :has-linkage false})]
+      {:parameter unique-name
+       :ident->symbol updated-identifier-map})))
+
+(defn- resolve-parameters [params ident->symbol]
+  (reduce (fn [acc p]
+            (let [{:keys [parameter ident->symbol]} (resolve-parameter p (:ident->symbol acc))]
+              {:parameters (conj (:parameters acc) parameter)
+               :ident->symbol ident->symbol}))
+          {:parameters [] :ident->symbol ident->symbol}
+          params))
+
+(defn- resolve-function-declaration
+  "Resolve function declaration.
+
+  Ensures functions not declared twice in current scope with incorrect linkage."
+  [{:keys [identifier storage-class parameters function-type body] :as d} ident->symbol]
+  (let [prev-entry (get ident->symbol identifier)
+        already-declared-var? (and (contains?  ident->symbol identifier)
+                                   (:from-current-scope (get ident->symbol identifier))
+                                   (not (:has-linkage prev-entry)))
+        illegally-redeclared? (and (contains? ident->symbol identifier)
+                                   (:from-current-scope prev-entry)
+                                   (not (:has-linkage prev-entry)))
+        static? (= :static storage-class)
+        inside-function-definition? (not (:at-top-level ident->symbol))
+        _ (when already-declared-var?
+            (exc/analyzer-error "Variable already declared in same scope." {:declaration d}))
+        _ (when illegally-redeclared?
+            (exc/analyzer-error "Function duplicate declaration." {:declaration d}))
+        updated-identifier-map (assoc ident->symbol identifier {:new-name identifier
+                                                                :name identifier
+                                                                :from-current-scope true
+                                                                :has-linkage true})
+        inner-map (copy-identifier-map updated-identifier-map)
+        {new-params :parameters, inner-map :ident->symbol} (resolve-parameters parameters inner-map)
+        _ (when (and body inside-function-definition?)
+            (exc/analyzer-error "Nested function definition not allowed." {:declaration d
+                                                                           :ident->symbol ident->symbol}))
+        _ (when (and inside-function-definition? static?)
+            (exc/analyzer-error "Nested static function declarations cannot exist." {:declaration d}))
+        new-body (when body (resolve-block body inner-map))]
+    {:declaration (p/function-declaration-node function-type storage-class identifier new-params (:block new-body))
+     :ident->symbol updated-identifier-map}))
+
+(defn- resolve-declaration [{:keys [declaration-type] :as d} ident->symbol]
+  (condp = declaration-type
+    :variable (resolve-variable-declaration d ident->symbol)
+    :function (resolve-function-declaration d ident->symbol)
+    (exc/analyzer-error "Invalid declaration type" {:declaration d})))
+
+(defn- resolve-for-init [for-init ident->symbol]
+  (if (= (:type for-init) :declaration)
+    (resolve-declaration for-init ident->symbol)
+    (resolve-optional-exp for-init ident->symbol)))
+
+(defmulti resolve-statement
+  "Resolves statements in a given scope.
+
+  Scope here refers to the ident->symbol map, which holds declarations
+  visisble to statement at this time.
+
+  Dispatches based on the type of statement.
+
+  Returns statement after recursively resolving all expressions and statements.
+  "
+  (fn [statement _ident->symbol]
+    (:statement-type statement)))
+
+(defmethod resolve-statement :default [statement _]
+  (exc/analyzer-error "Invalid statement." {:statement statement}))
+
+(defmethod resolve-statement :return [{:keys [value]} ident->symbol]
+  (p/return-statement-node (resolve-exp value ident->symbol)))
+
+(defmethod resolve-statement :break [statement _]
+  statement)
+
+(defmethod resolve-statement :continue [statement _]
+  statement)
+
+(defmethod resolve-statement :empty [statement _]
+  statement)
+
+(defmethod resolve-statement :expression [{:keys [value]} ident->symbol]
+  (p/expression-statement-node (resolve-exp value ident->symbol)))
+
+(defmethod resolve-statement :if [{:keys [condition then-statement else-statement]} ident->symbol]
+  (if else-statement
+    (p/if-statement-node (resolve-exp condition ident->symbol)
+                         (resolve-statement then-statement ident->symbol)
+                         (resolve-statement else-statement ident->symbol))
+    (p/if-statement-node (resolve-exp condition ident->symbol)
+                         (resolve-statement then-statement ident->symbol))))
+
+(defmethod resolve-statement :while [{:keys [condition body]} ident->symbol]
+  (p/while-statement-node (resolve-exp condition ident->symbol)
+                          (resolve-statement body ident->symbol)))
+
+(defmethod resolve-statement :do-while [{:keys [condition body]} ident->symbol]
+  (p/do-while-statement-node (resolve-exp condition ident->symbol)
+                             (resolve-statement body ident->symbol)))
+
+(defmethod resolve-statement :for [{:keys [init condition post body]} ident->symbol]
+  (let [for-scope-identifier-map (copy-identifier-map ident->symbol)
+        resolved-for-init (resolve-for-init init for-scope-identifier-map)
+        for-scope-identifier-map (if (:declaration resolved-for-init) ; updates symbol map if for initializer is declaration
+                                   (:ident->symbol resolved-for-init)
+                                   for-scope-identifier-map)
+        resolved-for-init (if (:declaration resolved-for-init) ; getting the underlying declaration, if it is
+                            (:declaration resolved-for-init)
+                            resolved-for-init)
+        condition (resolve-optional-exp condition for-scope-identifier-map)
+        post (resolve-optional-exp post for-scope-identifier-map)
+        body (resolve-statement body for-scope-identifier-map)]
+    (p/for-statement-node resolved-for-init condition post body)))
+
+(defmethod resolve-statement :compound [{:keys [block]} ident->symbol]
+  (p/compound-statement-node (:block (resolve-block block (copy-identifier-map ident->symbol)))))
+
+(defn- resolve-block-item [{:keys [type] :as item} ident->symbol]
+  (condp = type
+    :declaration (let [{d :declaration
+                        i->s :ident->symbol} (resolve-declaration item ident->symbol)]
+                   {:block-item d
+                    :ident->symbol i->s})
+    :statement {:block-item (resolve-statement item ident->symbol)
+                :ident->symbol ident->symbol}))
+
+(defn- resolve-block
+  "Resolves a block under a given symbol table.
+
+  Block is list of block items.
+
+  ident->symbol holds identifier to symbol mapping.
+  Symbol contains the type information, generated variable name etc.
+
+  | key            | description |
+  |----------------|-------------|
+  |`:at-top-level` | Is current level top or not ( default true)|"
+  ([block]
+   (resolve-block block {:at-top-level true}))
+  ([block ident->symbol]
+   (let [reduce-f (fn [acc block-item]
+                    (let [res (resolve-block-item block-item (:ident->symbol acc))]
+                      {:block (conj (:block acc) (:block-item res))
+                       :ident->symbol (:ident->symbol res)}))]
+     (reduce reduce-f
+             {:block []
+              :ident->symbol ident->symbol}
+             block))))
+
+;; Program is list of block items, which are themselves just blocks.
+(defn resolve-program [program]
+  (let [res (:block (resolve-block program))]
+        ; _ (m/coerce s/Program res)]
+    res))
+
+(comment
+
+  (def file-path "./test-programs/example.c")
+
+  (slurp "./test-programs/example.c")
+
+  (-> file-path
+      slurp
+      p/parse-from-src)
+
+  (-> file-path
+      slurp
+      p/parse-from-src
+      resolve-program)
+
+  (pretty/explain
+   s/Program
+   (-> file-path
+       slurp
+       p/parse-from-src
+       resolve-program))
+
+  ())
diff --git a/cljcc-compiler/src/cljcc/analyze/typecheck.clj b/cljcc-compiler/src/cljcc/analyze/typecheck.clj
new file mode 100644
index 0000000..d1e79dc
--- /dev/null
+++ b/cljcc-compiler/src/cljcc/analyze/typecheck.clj
@@ -0,0 +1,537 @@
+(ns cljcc.analyze.typecheck
+  (:require [malli.core :as m]
+            [malli.dev.pretty :as pretty]
+            [cljcc.parser :as p]
+            [cljcc.token :as t]
+            [cljcc.schema :as s]
+            [cljcc.symbol :as sym]
+            [clojure.core.match :refer [match]]
+            [cljcc.analyze.resolve :as r]
+            [cljcc.analyze.label-loops :as l]
+            [cljcc.exception :as exc]
+            [cljcc.util :as u]))
+
+(declare typecheck-block typecheck-declaration to-static-init)
+
+(defn set-type
+  "Assocs onto an expression given type."
+  [e t] (assoc e :value-type t))
+
+(defn get-type [e] (:value-type e))
+
+(defn- symbol-function? [s]
+  (= :function (:type (:type s))))
+
+(defmulti typecheck-exp
+  "Returns the expression, after typechecking nested expressions."
+  (fn [{:keys [exp-type]} _ident->symbol] exp-type))
+
+(defmethod typecheck-exp :constant-exp
+  [{:keys [value] :as e} _]
+  (condp = (:type value)
+    :int (set-type e {:type :int})
+    :long (set-type e {:type :long})
+    :uint (set-type e {:type :uint})
+    :ulong (set-type e {:type :ulong})
+    :double (set-type e {:type :double})
+    (exc/analyzer-error "Invalid type for constant expression." {:e e})))
+
+(defmethod typecheck-exp :variable-exp
+  [{:keys [identifier] :as e} ident->symbol]
+  (let [s (get ident->symbol identifier)]
+    (if (symbol-function? s)
+      (exc/analyzer-error "Function name used as variable." {:expression e})
+      (set-type e (:type s)))))
+
+(defmethod typecheck-exp :cast-exp
+  [{:keys [target-type value]} ident->symbol]
+  (let [typed-inner-e (typecheck-exp value ident->symbol)
+        cast-exp (p/cast-exp-node target-type typed-inner-e)]
+    (set-type cast-exp target-type)))
+
+(defmethod typecheck-exp :unary-exp
+  [{:keys [unary-operator value] :as e} ident->symbol]
+  (let [typed-inner-e (typecheck-exp value ident->symbol)
+        _ (when (and (= unary-operator :complement) (= {:type :double} (get-type typed-inner-e)))
+            (exc/analyzer-error "Can't take bitwise complement of double" {:expression e}))
+        unary-exp (p/unary-exp-node unary-operator typed-inner-e)]
+    (condp = unary-operator
+      :logical-not (set-type unary-exp {:type :int})
+      (set-type unary-exp (get-type typed-inner-e)))))
+
+(defn- get-common-type [t1 t2]
+  (cond
+    (= t1 t2) t1
+    (or (= t1 {:type :double})
+        (= t2 {:type :double})) {:type :double}
+    (= (u/get-type-size t1)
+       (u/get-type-size t2)) (if (u/type-signed? t1)
+                               t2
+                               t1)
+    (> (u/get-type-size t1)
+       (u/get-type-size t2)) t1
+    :else t2))
+
+(defn- convert-to-exp
+  "Returns expression, using casting if necessary."
+  [e t]
+  (if (= (get-type e) t)
+    e
+    (set-type (p/cast-exp-node t e) t)))
+
+(defmethod typecheck-exp :binary-exp
+  [{:keys [left right binary-operator] :as e} ident->symbol]
+  (let
+   [typed-left-e (typecheck-exp left ident->symbol)
+    typed-right-e (typecheck-exp right ident->symbol)]
+    (if (t/logical? binary-operator)
+      (set-type (p/binary-exp-node typed-left-e
+                                   typed-right-e
+                                   binary-operator)
+                {:type :int})
+      (let [tl (get-type typed-left-e)
+            tr (get-type typed-right-e)
+            _ (when (and (= :remainder binary-operator)
+                         (or (= {:type :double} tl)
+                             (= {:type :double} tr)))
+                (exc/analyzer-error "Operands to remainder operation cannot be double." {:expression e}))
+            common-type (get-common-type tl tr)
+            convert-left-exp (convert-to-exp typed-left-e common-type)
+            convert-right-exp (convert-to-exp typed-right-e common-type)
+            typed-binary-exp (p/binary-exp-node convert-left-exp convert-right-exp binary-operator)]
+        (if (t/arithmetic? binary-operator)
+          (set-type typed-binary-exp common-type)
+          (set-type typed-binary-exp {:type :int}))))))
+
+(defmethod typecheck-exp :assignment-exp
+  [{:keys [left right assignment-operator] :as _e} ident->symbol]
+  (let
+   [typed-left (typecheck-exp left ident->symbol)
+    typed-right (typecheck-exp right ident->symbol)
+    left-type (get-type typed-left)
+    converted-right (convert-to-exp typed-right left-type)
+    typed-assign-exp (p/assignment-exp-node typed-left converted-right assignment-operator)]
+    (set-type typed-assign-exp left-type)))
+
+(defmethod typecheck-exp :conditional-exp
+  [{:keys [left right middle] :as _e} m]
+  (let [t-left (typecheck-exp left m)
+        t-right (typecheck-exp right m)
+        t-middle (typecheck-exp middle m)
+        common-type (get-common-type (get-type t-middle) (get-type t-right))
+        convert-right (convert-to-exp t-right common-type)
+        convert-middle (convert-to-exp t-middle common-type)
+        typed-cond-e (p/conditional-exp-node t-left convert-middle convert-right)]
+    (set-type typed-cond-e common-type)))
+
+(defmethod typecheck-exp :function-call-exp
+  [{:keys [identifier arguments] :as e} ident->symbol]
+  (let
+   [{ftype :type :as symbol} (get ident->symbol identifier)]
+    (if (symbol-function? symbol)
+      (let [_ (when (not= (count arguments) (count (:parameter-types ftype)))
+                (exc/analyzer-error "Function called with wrong number of arguments."
+                                    {:expected (count (:parameter-types ftype))
+                                     :actual (count arguments)}))
+            cast-arg-to-param-type-f (fn [param-type arg]
+                                       (convert-to-exp (typecheck-exp arg ident->symbol)
+                                                       param-type))
+            converted-args (mapv cast-arg-to-param-type-f
+                                 (:parameter-types ftype)
+                                 arguments)
+            typed-fun-call-exp (p/function-call-exp-node identifier converted-args)]
+        (set-type typed-fun-call-exp (:return-type ftype)))
+      (exc/analyzer-error "Variable used as function name" {:symbol symbol
+                                                            :expression e}))))
+
+(defmulti typecheck-statement
+  "Dispatches based on type of statement.
+
+  Parameters:
+  - return-type: Return type of statement's enclosing function.
+  - statement
+  - ident->symbol: Symbol map for current scope."
+  (fn [_return-type {:keys [statement-type]} _ident->symbol]
+    statement-type))
+
+(defmethod typecheck-statement :return
+  [return-type {:keys [value]} ident->symbol]
+  {:statement (p/return-statement-node
+               (convert-to-exp (typecheck-exp value ident->symbol)
+                               return-type))
+   :ident->symbol ident->symbol})
+
+(defmethod typecheck-statement :expression
+  [_ {:keys [value]} ident->symbol]
+  {:statement (p/expression-statement-node (typecheck-exp value ident->symbol))
+   :ident->symbol ident->symbol})
+
+(defmethod typecheck-statement :break
+  [_ s m]
+  {:statement s
+   :ident->symbol m})
+
+(defmethod typecheck-statement :continue
+  [_ s m]
+  {:statement s
+   :ident->symbol m})
+
+(defmethod typecheck-statement :empty
+  [_ s m]
+  {:statement s
+   :ident->symbol m})
+
+(defmethod typecheck-statement :while
+  [return-type {:keys [condition body] :as stmt} m]
+  (let [typed-cond (typecheck-exp condition m)
+        typed-body (typecheck-statement return-type body m)]
+    {:statement (merge stmt (p/while-statement-node
+                             typed-cond
+                             (:statement typed-body)))
+     :ident->symbol (:ident->symbol typed-body)}))
+
+(defmethod typecheck-statement :do-while
+  [return-type {:keys [condition body] :as stmt} m]
+  (let [typed-cond (typecheck-exp condition m)
+        typed-body (typecheck-statement return-type body m)]
+    {:statement (merge stmt (p/do-while-statement-node
+                             typed-cond
+                             (:statement typed-body)))
+     :ident->symbol (:ident->symbol typed-body)}))
+
+(defn- typecheck-optional-expression [e m]
+  (if (nil? e)
+    e
+    (typecheck-exp e m)))
+
+(defn- typecheck-for-init [for-init ident->symbol]
+  (if (= (:type for-init) :declaration)
+    (typecheck-declaration for-init ident->symbol)
+    (typecheck-optional-expression for-init ident->symbol)))
+
+(defmethod typecheck-statement :for
+  [return-type {:keys [init post condition body] :as stmt} m]
+  (let [f-init (typecheck-for-init init m)
+        m' (if (:declaration f-init)
+             (:ident->symbol f-init)
+             m)
+        f-init (if (:declaration f-init)
+                 (:declaration f-init)
+                 f-init)
+        t-condition (typecheck-optional-expression condition m')
+        t-post (typecheck-optional-expression post m')
+        typed-body-statement (typecheck-statement return-type body m')]
+    {:statement (merge stmt
+                       (p/for-statement-node f-init t-condition t-post (:statement typed-body-statement)))
+     :ident->symbol (:ident->symbol typed-body-statement)}))
+
+(defmethod typecheck-statement :if
+  [return-type {:keys [condition then-statement else-statement]} m]
+  (if else-statement
+    (let [t-condition (typecheck-exp condition m)
+          {t-then :statement
+           m :ident->symbol} (typecheck-statement return-type then-statement m)
+          {t-else :statement
+           m :ident->symbol} (typecheck-statement return-type else-statement m)]
+      {:statement (p/if-statement-node t-condition t-then t-else)
+       :ident->symbol m})
+    (let [t-condition (typecheck-exp condition m)
+          {t-then :statement
+           m :ident->symbol} (typecheck-statement return-type then-statement m)]
+      {:statement (p/if-statement-node t-condition t-then)
+       :ident->symbol m})))
+
+(defmethod typecheck-statement :compound
+  [return-type {:keys [block]} m]
+  (let [typed-block (typecheck-block return-type block m)]
+    {:statement (p/compound-statement-node (:block typed-block))
+     :ident->symbol (:ident->symbol typed-block)}))
+
+(defn- typecheck-item [return-type {:keys [type] :as item} m]
+  (condp = type
+    :declaration (let [v (typecheck-declaration item m)]
+                   {:block-item (:declaration v)
+                    :ident->symbol (:ident->symbol v)})
+    :statement (let [v (typecheck-statement return-type item m)]
+                 {:block-item (:statement v)
+                  :ident->symbol (:ident->symbol v)})
+    (exc/analyzer-error "Invalid statement/declaration." item)))
+
+(defn- typecheck-block [return-type block ident->symbol]
+  (reduce (fn [acc item]
+            (let [v (typecheck-item return-type item (:ident->symbol acc))]
+              {:block (conj (:block acc) (:block-item v))
+               :ident->symbol (:ident->symbol v)}))
+          {:block []
+           :ident->symbol ident->symbol}
+          block))
+
+(defn- get-initial-value
+  [{:keys [initial storage-class variable-type] :as declaration}]
+  (let [constant-exp? (= :constant-exp (:exp-type initial))]
+    (cond
+      constant-exp? (to-static-init initial variable-type)
+      (nil? initial) (if (= :extern storage-class)
+                       (sym/no-initializer-iv)
+                       (sym/tentative-iv))
+      :else (exc/analyzer-error "Non-constant initializer." declaration))))
+
+(defn- const-convert
+  "Converts a constant initializer to a specific variable type.
+
+  Does type conversion if necessary."
+  [{ttype :type :as target-type} {const-type :type value :value :as const}]
+  (match [ttype const-type]
+    [:double :ulong] {:type :double
+                      :value (-> value
+                                 biginteger
+                                 (.doubleValue))}
+    [:double _] {:type :double
+                 :value (double value)}
+    [:ulong :double] {:type :ulong
+                      :value (-> value
+                                 biginteger
+                                 (.longValue))}
+    [(:or :int :uint) _] {:type ttype
+                          :value (-> value
+                                     unchecked-int
+                                     long)}
+    [(:or :long :ulong) _] {:type ttype
+                            :value (long value)}
+    :else (exc/analyzer-error "Invalid type passed to const-convert function."
+                              {:const const
+                               :target-type target-type})))
+
+(defn- zero-initializer
+  "Returns zero const initializer based on passed type."
+  [{:keys [type] :as _t}]
+  (condp = type
+    :int (sym/int-init 0)
+    :uint (sym/uint-init 0)
+    :long (sym/long-init 0)
+    :ulong (sym/ulong-init 0)
+    :double (sym/double-init (double 0))))
+
+(defn- to-static-init [{:keys [value exp-type] :as e} var-type]
+  (cond
+    (= :constant-exp exp-type) (let [{const-type :type
+                                      const-value :value} (const-convert var-type value)]
+                                 (condp = const-type
+                                   :int (sym/initial-iv (sym/int-init const-value))
+                                   :long (sym/initial-iv (sym/long-init const-value))
+                                   :uint (sym/initial-iv (sym/uint-init const-value))
+                                   :ulong (sym/initial-iv (sym/ulong-init const-value))
+                                   :double (sym/initial-iv (sym/double-init const-value))))
+    (nil? e) (sym/initial-iv (zero-initializer var-type))
+    :else (exc/analyzer-error "Non-constant initializer on static variable." e)))
+
+(defn- validate-file-scope-variable-declaration
+  [{:keys [variable-type storage-class] :as cur-decl} prev-symbol]
+  (let [_ (when (not= variable-type (:type prev-symbol))
+            (exc/analyzer-error "Redeclared with different types." {:declaration1 cur-decl
+                                                                    :declaration2 prev-symbol}))
+        global? (not= :static storage-class)
+        global? (cond
+                  (= :extern storage-class) (get-in prev-symbol [:attribute :global?])
+                  (not= global? (get-in prev-symbol [:attribute :global?])) (exc/analyzer-error "Conflicting variable linkage." {:d1 cur-decl
+                                                                                                                                 :d2 prev-symbol})
+                  :else global?)
+        initial-value (get-initial-value cur-decl)
+        initial-value (cond
+                        (=
+                         :initial
+                         (get-in prev-symbol [:attribute :initial-value :type])) (if (= (:type initial-value) :initial)
+                                                                                   (exc/analyzer-error "Conflicting file scope variable definition." {:d1 cur-decl
+                                                                                                                                                      :d2 prev-symbol})
+                                                                                   (get-in prev-symbol [:attribute :initial-value]))
+                        (and
+                         (= :tentative (get-in prev-symbol [:attribute :initial-value :type]))
+                         (not= :initial (:type initial-value))) {:type :tentative}
+                        :else initial-value)]
+    {:global? global?
+     :initial-value initial-value}))
+
+(defn- typecheck-file-scope-variable-declaration
+  [{:keys [identifier storage-class variable-type] :as d} ident->symbol]
+  (let [prev-symbol (get ident->symbol identifier)
+        global? (not= :static storage-class)
+        initial-value (get-initial-value d)
+        {global? :global?
+         initial-value :initial-value} (if prev-symbol
+                                         (validate-file-scope-variable-declaration d prev-symbol)
+                                         {:global? global?
+                                          :initial-value initial-value})]
+    {:declaration d
+     :ident->symbol (assoc ident->symbol
+                           identifier
+                           (sym/create-symbol variable-type (sym/static-attribute initial-value global?)))}))
+
+(defn- typecheck-local-scope-variable-declaration
+  [{:keys [identifier variable-type storage-class initial] :as d} ident->symbol]
+  (condp = storage-class
+    :extern (let [_ (when (not (nil? initial))
+                      (exc/analyzer-error "Initializer on local extern variable declaration." d))
+                  prev-symbol (get ident->symbol identifier)
+                  prev-type (:type prev-symbol)
+                  _ (when (and prev-symbol (not= prev-type variable-type))
+                      (exc/analyzer-error "Redeclared with different types." {:declaration1 d
+                                                                              :declaration2 prev-symbol}))
+                  symbols (if prev-symbol
+                            ident->symbol
+                            (assoc ident->symbol
+                                   identifier
+                                   (sym/create-symbol variable-type (sym/static-attribute (sym/no-initializer-iv) true))))]
+              {:declaration d
+               :ident->symbol symbols})
+    :static (let [initial-value (to-static-init initial variable-type)
+                  updated-symbols (assoc ident->symbol
+                                         identifier
+                                         (sym/create-symbol variable-type (sym/static-attribute initial-value false)))]
+              {:declaration d
+               :ident->symbol updated-symbols})
+    (let [updated-symbols (assoc ident->symbol
+                                 identifier
+                                 (sym/create-symbol
+                                  variable-type
+                                  (sym/local-attribute)))
+          casted-e (if (nil? initial)
+                     initial
+                     (convert-to-exp initial variable-type))
+          t-e (typecheck-optional-expression casted-e updated-symbols)]
+      {:declaration (assoc d :initial t-e)
+       :ident->symbol updated-symbols})))
+
+(defn- validate-old-fn-decl-return-attribute
+  [cur-decl prev-symbol]
+  (let [prev-function? (= :function (get-in prev-symbol [:type :type]))
+        _ (when-not prev-function?
+            (exc/analyzer-error "Variable being redeclared as function." {:declaration cur-decl
+                                                                          :prev-symbol prev-symbol}))
+        same-type? (and (= (get-in cur-decl [:function-type :parameter-types])
+                           (get-in prev-symbol [:type :parameter-types]))
+                        (= (get-in cur-decl [:function-type :return-type])
+                           (get-in prev-symbol [:type :return-type])))
+        _ (when-not same-type?
+            (exc/analyzer-error "Incompatible function type declarations." {:declaration cur-decl
+                                                                            :prev-declaration-type prev-symbol}))
+        defined? (seq (:body cur-decl))
+        prev-defined? (get-in prev-symbol [:attribute :defined?])
+        _ (when (and defined? prev-defined?)
+            (exc/analyzer-error "Function defined more than once." {:declaration cur-decl}))
+        current-static? (= :static (:storage-class cur-decl))
+        old-global? (get-in prev-symbol [:attribute :global?])
+        _ (when (and old-global? current-static?)
+            (exc/analyzer-error "Static function definition follows non static." {:declaration cur-decl}))]
+    {:defined? prev-defined?
+     :global? old-global?}))
+
+(defn- add-parameter-to-symbols
+  [parameters function-type ident->symbol]
+  (if (zero? (count parameters))
+    ident->symbol
+    (apply assoc
+           ident->symbol
+           (flatten
+            (map (fn [p t]
+                   [p (sym/create-symbol t (sym/local-attribute))])
+                 parameters
+                 (:parameter-types function-type))))))
+
+(defn- typecheck-function-declaration
+  [{:keys [identifier storage-class body parameters function-type] :as d} ident->symbol]
+  (let [body? (seq body)
+        prev-symbol (get ident->symbol identifier)
+        {defined? :defined?
+         global? :global?} (if prev-symbol
+                             (validate-old-fn-decl-return-attribute d prev-symbol)
+                             {:defined? false
+                              :global? (not= :static storage-class)})
+        function-attribute (sym/fun-attribute (boolean (or defined? body?)) global?)
+        updated-symbols (assoc ident->symbol
+                               identifier
+                               (sym/create-symbol
+                                function-type
+                                function-attribute))]
+    (if body?
+      (let [with-parameter-symbols (add-parameter-to-symbols
+                                    parameters
+                                    function-type
+                                    updated-symbols)
+            with-body-symbols (typecheck-block (:return-type function-type)
+                                               body
+                                               (assoc with-parameter-symbols
+                                                      :at-top-level false))]
+        {:declaration (assoc d :body (:block with-body-symbols))
+         :ident->symbol (assoc (:ident->symbol with-body-symbols)
+                               :at-top-level true)})
+      {:declaration d
+       :ident->symbol updated-symbols})))
+
+(defn- typecheck-declaration
+  [{:keys [declaration-type] :as d} ident->symbol]
+  (let [at-top-level? (:at-top-level ident->symbol)]
+    (condp = declaration-type
+      :variable (if at-top-level?
+                  (typecheck-file-scope-variable-declaration d ident->symbol)
+                  (typecheck-local-scope-variable-declaration d ident->symbol))
+      :function (typecheck-function-declaration d ident->symbol)
+      (exc/analyzer-error "Invalid declaration for typechecker." {:declaration d}))))
+
+(defn- typecheck-program [program]
+  (let [rf (fn [acc decl]
+             (let [d (typecheck-declaration decl (:ident->symbol acc))]
+               {:program (conj (:program acc) (:declaration d))
+                :ident->symbol (:ident->symbol d)}))]
+    (reduce rf
+            {:program []
+             :ident->symbol {:at-top-level true}}
+            program)))
+
+(defn typecheck
+  "Typechecks given program.
+
+  A program is a list of declarations."
+  [program]
+  (let [v (typecheck-program program)
+        program (:program v)
+        m (dissoc (:ident->symbol v) :at-top-level)
+        ;_ (m/coerce s/Program program)
+        ;_ (m/coerce s/SymbolMap m)
+        ]
+    {:program program
+     :ident->symbol m}))
+
+(comment
+
+  (def file-path "./test-programs/example.c")
+
+  (slurp "./test-programs/example.c")
+
+  (-> file-path
+      slurp
+      p/parse-from-src)
+
+  (-> file-path
+      slurp
+      p/parse-from-src
+      r/resolve-program
+      l/label-loops
+      typecheck)
+
+  (->
+   "unsigned long ul = 18446744073709549568.;"
+   p/parse-from-src
+   r/resolve-program
+   l/label-loops
+   typecheck)
+
+  (pretty/explain
+   s/TypecheckedOut
+   (-> file-path
+       slurp
+       p/parse-from-src
+       r/resolve-program
+       l/label-loops
+       typecheck))
+
+  ())