Add common functions for handling cljcc compiler

14 files changed, 157 insertions, 77 deletions

diff --git a/cli/build.clj b/cli/build.clj
new file mode 100644
index 0000000..47c8537
--- /dev/null
+++ b/cli/build.clj
@@ -0,0 +1,27 @@
+(ns build
+  (:refer-clojure :exclude [test])
+  (:require [clojure.tools.build.api :as b]))
+
+(def lib 'net.clojars.cljcc/cljcc)
+(def main 'cljcc.cljcc)
+(def class-dir "../target/classes")
+
+(defn- uber-opts [opts]
+  (assoc opts
+         :lib lib :main main
+         :uber-file "../target/cljcc/cljcc.jar"
+         :basis (b/create-basis {})
+         :class-dir class-dir
+         :src-dirs ["src"]
+         :ns-compile [main]))
+
+(defn ci "Run the CI pipeline of tests (and build the uberjar)." [opts]
+  (b/delete {:path "../target"})
+  (let [opts (uber-opts opts)]
+    (println "\nCopying source...")
+    (b/copy-dir {:src-dirs ["resources" "src"] :target-dir class-dir})
+    (println (str "\nCompiling " main "..."))
+    (b/compile-clj opts)
+    (println "\nBuilding JAR...")
+    (b/uber opts))
+  opts)
diff --git a/cli/deps.edn b/cli/deps.edn
index 8d06ce6..b0313f3 100644
--- a/cli/deps.edn
+++ b/cli/deps.edn
@@ -1,4 +1,8 @@
 {:paths ["src"]
+ :deps {org.clojure/clojure {:mvn/version "1.11.1"}
+        org.clojure/tools.cli {:mvn/version "1.1.230"}
+        com.github.clj-easy/graal-build-time {:mvn/version "1.0.5"}
+        cljcc/cljcc {:local/root "../cljcc-compiler"}}
  :aliases
  {:run
   {:main-opts ["-m" "cli.cli"]}}}
diff --git a/cli/src/cli/cli.clj b/cli/src/cli/cli.clj
index f7aba04..5f27187 100644
--- a/cli/src/cli/cli.clj
+++ b/cli/src/cli/cli.clj
@@ -2,7 +2,7 @@
   (:require
    [clojure.tools.cli :refer [parse-opts]]
    [clojure.string :as string]
-   [cljcc.util :refer [exit]]
+   [cli.core.shell :refer [exit]]
    [cli.driver :as driver])
   (:gen-class))
 
diff --git a/cli/src/cli/driver.clj b/cli/src/cli/driver.clj
index 41a916f..76723f5 100644
--- a/cli/src/cli/driver.clj
+++ b/cli/src/cli/driver.clj
@@ -1,3 +1,4 @@
-(ns cli.driver)
+(ns cli.driver
+  (:require [cljcc.cljcc :as cljcc]))
 
 (defn run [& args])
diff --git a/cljcc-compiler/deps.edn b/cljcc-compiler/deps.edn
new file mode 100644
index 0000000..52fd6d7
--- /dev/null
+++ b/cljcc-compiler/deps.edn
@@ -0,0 +1,4 @@
+{:paths ["src"]
+ :deps {org.clojure/clojure {:mvn/version "1.11.1"}
+        org.clojure/core.match {:mvn/version "1.1.0"}
+        metosin/malli {:mvn/version "0.16.4"}}}
diff --git a/cljcc-compiler/src/cljcc/cljcc.cljc b/cljcc-compiler/src/cljcc/cljcc.cljc
index c067b75..742c1c2 100644
--- a/cljcc-compiler/src/cljcc/cljcc.cljc
+++ b/cljcc-compiler/src/cljcc/cljcc.cljc
@@ -1,11 +1,18 @@
 (ns cljcc.cljcc
   (:require
-   [clojure.tools.cli :refer [parse-opts]]
-   [clojure.string :as string]
-   [cljcc.util :refer [exit]]
-   [cljcc.driver :as d])
+   [cljcc.lexer :as lexer]
+   [cljcc.parser :as parser]
+   [cljcc.tacky :as tacky]
+   [cljcc.analyze.core :as analyzer]
+   [cljcc.compiler :as codegen]
+   [cljcc.emit :as emit])
   (:gen-class))
 
+#?(:clj  (set! *warn-on-reflection* true))
+
+(def valid-os-targets #{:mac :linux})
+(def valid-stages #{:lex :parse :validate :tacky :codegen :emit})
+
 (defn run
   "Compiles source input using specified compiler options.
 
@@ -13,54 +20,30 @@
     source - Source C file.
     options - Map of compiler configuration options.
 
-  Returns generated AST for specified stage."
-  [source & {:keys [config] :or {config {}}}]
-  (let [default-config {:target {:os :linux}}]))
-
-(set! *warn-on-reflection* true)
-
-(defn usage [options-summary]
-  (->>
-   ["Usage: ./cljcc path/to/file.c [options]"
-    ""
-    "Options:"
-    options-summary]
-   (string/join \newline)))
+  Options map:
+    :target - Map of target platform settings
+      :os - Target OS #{:linux :mac}
+    :stage - Which stage to generate #{:lex :parse :validate :tacky :codegen :emit}
 
-(def cli-options
-  [[nil "--lex" "Runs lexer. Does not emit any files."]
-   [nil "--parse" "Runs parser. Does not emit any files."]
-   [nil "--validate" "Runs semantic analyzer. Does not emit any files."]
-   [nil "--tacky" "Runs tacky generation. Does not emit any files."]
-   [nil "--codegen" "Runs compiler. Does not emit any files."]
-   ["-c" nil "Generate object file."
-    :id :generate-object-file]
-   ["-h" "--help"]])
-
-(defn validate-args [args]
-  (let [{:keys [options arguments summary]} (parse-opts args cli-options)]
-    (cond
-      (:help options) {:exit-message (usage summary) :ok? true}
-      (= 1 (count arguments)) {:file-path (first arguments)
-                               :options options}
-      :else {:exit-message (usage summary)})))
-
-(defn -main
-  "Main entrypoint for cljcc compiler."
-  [& args]
-  (let [{:keys [file-path exit-message ok? options]} (validate-args args)
-        libs (filterv (fn [v] (and
-                               (string? v)
-                               (re-matches #"-l.+" v)))
-                      args)]
-    (if exit-message
-      (exit (if ok? 0 1) exit-message)
-      (try
-        (d/run file-path (assoc options :libs libs))
-        (exit 0 "Successfully executed.")
-        (catch Exception e
-          (exit 1 (ex-message e) e))))))
-
-(comment
+  Returns generated AST for specified stage."
+  [source & {:keys [options] :or {options {}}}]
+  (let [default-options {:target {:os :linux}
+                         :stage :emit}
+        merged-options (merge default-options options)
+        stage (:stage merged-options)
+        target-os (:os (:target merged-options))
+        _ (assert (stage valid-stages) "Invalid stage for compilation.")
+        _ (assert (target-os valid-os-targets) "Invalid operating system.")
+        stages [lexer/lex parser/parse
+                analyzer/validate tacky/tacky-generate
+                codegen/assembly emit/emit]
+        stage-idx (condp = stage
+                    :lex 1
+                    :parse 2
+                    :validate 3
+                    :tacky 4
+                    :codegen 5
+                    :emit 6)
+        stages-to-run (vec (take stage-idx stages))]
+    (reduce (fn [acc f] (f acc)) source stages-to-run)))
 
-  ())
diff --git a/cljcc-compiler/src/cljcc/core/exception.cljc b/cljcc-compiler/src/cljcc/core/exception.cljc
new file mode 100644
index 0000000..19245aa
--- /dev/null
+++ b/cljcc-compiler/src/cljcc/core/exception.cljc
@@ -0,0 +1,34 @@
+(ns cljcc.core.exception
+  (:require [cljcc.core.format :refer [safe-format]]))
+
+(defn try-catch-ex
+  ([f]
+   (try
+     (f)
+     (catch #?(:clj Throwable :cljs :default) e
+       [:error e])))
+  ([f default]
+   (try
+     (f)
+     (catch #?(:clj Throwable :cljs :default) e
+       default))))
+
+(defn lex-error [{line :line col :col :as data}]
+  (throw (ex-info
+          (safe-format "Invalid token at line: %s, col: %s." line col)
+          (merge {:error/type :lexer} data))))
+
+(defn parser-error [msg data]
+  (throw (ex-info msg (merge {:error/type :parser} data))))
+
+(defn analyzer-error [msg data]
+  (throw (ex-info msg (merge {:error/type :analyzer} data))))
+
+(defn tacky-error [msg data]
+  (throw (ex-info msg (merge {:error/type :tacky} data))))
+
+(defn compiler-error [msg data]
+  (throw (ex-info msg (merge {:error/type :compiler} data))))
+
+(defn emit-error [msg data]
+  (throw (ex-info msg (merge {:error/type :emit} data))))
diff --git a/cljcc-compiler/src/cljcc/core/format.cljc b/cljcc-compiler/src/cljcc/core/format.cljc
new file mode 100644
index 0000000..851b6a1
--- /dev/null
+++ b/cljcc-compiler/src/cljcc/core/format.cljc
@@ -0,0 +1,10 @@
+(ns cljcc.core.format
+  #?(:clj (:require [clojure.core :refer [format]])
+     :cljs (:require [goog.string :as gstring]
+                     [goog.string.format])))
+
+(defn safe-format
+  "Cross platform format."
+  [fmt & args]
+  #?(:clj (apply format fmt args)
+     :cljs (apply gstring/format fmt args)))
diff --git a/cljcc-compiler/src/cljcc/core/log.cljc b/cljcc-compiler/src/cljcc/core/log.cljc
new file mode 100644
index 0000000..bb92b02
--- /dev/null
+++ b/cljcc-compiler/src/cljcc/core/log.cljc
@@ -0,0 +1,28 @@
+(ns cljcc.core.log
+  (:require [clojure.string :as str]))
+
+(def ^:private log-colors
+  {:debug "\u001b[36m" ; Cyan
+   :info  "\u001b[32m" ; Green
+   :warn  "\u001b[33m" ; Yellow
+   :error "\u001b[31m" ; Red
+   :reset "\u001b[0m"}) ; Reset color
+
+(def reset-color (get log-colors :reset))
+
+(defn- log-message [level message]
+  (let [color (get log-colors level)
+        formatted-message (str color "[" (str/upper-case (name level)) "] " message reset-color)]
+    (println formatted-message)))
+
+(defn debug [msg]
+  (log-message :debug msg))
+
+(defn info [msg]
+  (log-message :info msg))
+
+(defn warn [msg]
+  (log-message :warn msg))
+
+(defn error [msg]
+  (log-message :error msg))
diff --git a/cljcc-compiler/src/cljcc/emit.cljc b/cljcc-compiler/src/cljcc/emit.cljc
index 0686b31..b4fdc13 100644
--- a/cljcc-compiler/src/cljcc/emit.cljc
+++ b/cljcc-compiler/src/cljcc/emit.cljc
@@ -2,8 +2,9 @@
   (:require
    [cljcc.util :refer [get-os]]
    [cljcc.compiler :as c]
+   [cljcc.core.format :refer [safe-format]]
    [clojure.string :as str]
-   [cljcc.exception :as exc]))
+   [cljcc.core.exception :as exc]))
 
 (defn- handle-label [identifier]
   (condp = (get-os)
@@ -26,13 +27,13 @@
 ;;;; Operand Emit
 
 (defn- imm-opernad-emit [operand _opts]
-  (format "$%d" (:value operand)))
+  (safe-format "$%d" (:value operand)))
 
 (defn- stack-operand-emit [operand _opts]
-  (format "%d(%%rbp)" (:value operand)))
+  (safe-format "%d(%%rbp)" (:value operand)))
 
 (defn- data-operand-emit [operand _opts]
-  (format "%s(%%rip)" (handle-symbol-name (:identifier operand))))
+  (safe-format "%s(%%rip)" (handle-symbol-name (:identifier operand))))
 
 (defn- register-operand [{:keys [register] :as operand} {register-width :register-width :or {register-width :4-byte}}]
   (let [register->width->output {:ax {:8-byte "%rax"
@@ -95,7 +96,7 @@
   ([operand opts]
    (if-let [[_ operand-emit-fn] (find operand-emitters (:operand operand))]
      (operand-emit-fn operand opts)
-     (throw (AssertionError. (str "Invalid operand: " operand))))))
+     (exc/emit-error "Invalid operand" {:operand operand}))))
 
 ;;;; Instruction Emit
 
diff --git a/cljcc-compiler/src/cljcc/lexer.cljc b/cljcc-compiler/src/cljcc/lexer.cljc
index ef4235f..b2854cf 100644
--- a/cljcc-compiler/src/cljcc/lexer.cljc
+++ b/cljcc-compiler/src/cljcc/lexer.cljc
@@ -9,8 +9,6 @@
    :line 1
    :col 1})
 
-(set! *warn-on-reflection* true)
-
 (defn lex
   ([source]
    (lex source (lexer-ctx)))
@@ -75,7 +73,6 @@
     }
 ")
 
-
   (lex
    "
 int main(void) {
diff --git a/cljcc-compiler/src/cljcc/parser.cljc b/cljcc-compiler/src/cljcc/parser.cljc
index f8d039d..e505aa3 100644
--- a/cljcc-compiler/src/cljcc/parser.cljc
+++ b/cljcc-compiler/src/cljcc/parser.cljc
@@ -6,13 +6,11 @@
    [clojure.set :refer [union]]
    [malli.dev.pretty :as pretty]
    [cljcc.schema :as s]
-   [cljcc.exception :as exc]
+   [cljcc.core.exception :as exc]
    [cljcc.util :as u]))
 
 (declare parse parse-exp parse-statement parse-block expect parse-declaration parse-variable-declaration)
 
-(set! *warn-on-reflection* true)
-
 (def valid-declaration-starts
   (union t/type-specifier-keywords t/storage-specifier-keywords))
 
@@ -538,7 +536,7 @@
 
   (def file-path "./test-programs/example.c")
 
-  (slurp "./test-programs/example.c")
+  #?(:clj (slurp "./test-programs/example.c"))
 
   (-> file-path
       slurp
diff --git a/cljcc-compiler/src/cljcc/util.cljc b/cljcc-compiler/src/cljcc/util.cljc
index 4c56ab9..00f11dc 100644
--- a/cljcc-compiler/src/cljcc/util.cljc
+++ b/cljcc-compiler/src/cljcc/util.cljc
@@ -6,8 +6,6 @@
 
 (def ^:private counter "Global integer counter for generating unique identifier names." (atom 0))
 
-(set! *warn-on-reflection* true)
-
 (defn create-identifier!
   "Returns a unique identifier. Used for generating unique identifier.
 
diff --git a/deps.edn b/deps.edn
index 2dc0b92..1a50091 100644
--- a/deps.edn
+++ b/deps.edn
@@ -1,24 +1,19 @@
-{:paths ["src" "resources"]
+{:paths []
  :deps {org.clojure/clojure {:mvn/version "1.11.1"}
-        org.clojure/tools.cli {:mvn/version "1.1.230"}
         org.clojure/core.match {:mvn/version "1.1.0"}
-        io.github.humbleui/humbleui {:git/sha "03f30f8e832899b35e807f2e02efcdedfab5401d"}
         metosin/malli {:mvn/version "0.16.4"}
         com.github.clj-easy/graal-build-time {:mvn/version "1.0.5"}}
  :aliases
  {:cli
-  {:extra-paths ["cli/src"]
+  {:extra-paths ["cli/src" "cljcc_compiler/src"]
    :main-opts ["-m" "cli.cli"]}
   :run-m {:main-opts ["-m" "cljcc.cljcc"]}
   :build {:deps {io.github.clojure/tools.build
                  {:mvn/version "0.10.3"}}
           :jvm-opts ["-Dclojure.compiler.direct-linking=true"]
           :ns-default build}
-  :test {:extra-paths ["test"]
-         :extra-deps {org.clojure/test.check {:mvn/version "1.1.1"}
-                      io.github.cognitect-labs/test-runner
-                      {:git/tag "v0.5.1" :git/sha "dfb30dd"}}}
   :storm {;; for disabling the official compiler
+          :extra-paths ["cljcc_compiler/src" "cli/src"]
           :classpath-overrides {org.clojure/clojure nil}
           :extra-deps {io.github.clojure/tools.build {:mvn/version "0.10.3"}
                        nrepl/nrepl {:mvn/version "1.3.0"}