diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/cljcc/analyze/label_loops.clj | 5 | ||||
| -rw-r--r-- | src/cljcc/analyze/typecheck.clj | 90 | ||||
| -rw-r--r-- | src/cljcc/emit.clj | 6 | ||||
| -rw-r--r-- | src/cljcc/parser.clj | 12 | ||||
| -rw-r--r-- | src/cljcc/schema.clj | 131 | ||||
| -rw-r--r-- | src/cljcc/symbol.clj | 38 | ||||
| -rw-r--r-- | src/cljcc/symbols.clj | 10 | ||||
| -rw-r--r-- | src/cljcc/tacky.clj | 540 | ||||
| -rw-r--r-- | src/cljcc/token.clj | 21 |
9 files changed, 613 insertions, 240 deletions
diff --git a/src/cljcc/analyze/label_loops.clj b/src/cljcc/analyze/label_loops.clj index 94cefc2..56fffc9 100644 --- a/src/cljcc/analyze/label_loops.clj +++ b/src/cljcc/analyze/label_loops.clj @@ -2,6 +2,7 @@ (: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])) @@ -87,14 +88,14 @@ label-loops) (pretty/explain - p/Program + s/Program (-> "./test-programs/example.c" slurp p/parse-from-src r/resolve-program)) (pretty/explain - p/Program + s/Program (-> "./test-programs/example.c" slurp p/parse-from-src diff --git a/src/cljcc/analyze/typecheck.clj b/src/cljcc/analyze/typecheck.clj index 7f8134a..122e5be 100644 --- a/src/cljcc/analyze/typecheck.clj +++ b/src/cljcc/analyze/typecheck.clj @@ -4,51 +4,22 @@ [cljcc.parser :as p] [cljcc.token :as t] [cljcc.schema :as s] + [cljcc.symbol :as sym] [cljcc.analyze.resolve :as r] [cljcc.analyze.label-loops :as l] [cljcc.exception :as exc])) (declare typecheck-block typecheck-declaration to-static-init) -(defn- create-symbol [type attribute] - {:type type - :attribute attribute}) - -(defn- local-attribute [] - {:type :local}) - -(defn- static-attribute [initial-value global?] - {:type :static - :initial-value initial-value - :global? global?}) - -(defn- set-type +(defn set-type "Assocs onto an expression given type." [e t] (assoc e :value-type t)) -(defn- get-type [e] (:value-type e)) +(defn get-type [e] (:value-type e)) (defn- symbol-function? [s] (= :function (:type (:type s)))) -(defn- no-initializer-iv [] - {:type :no-initializer}) - -(defn- tentative-iv [] - {:type :tentative}) - -(defn- initial-iv [static-init] - {:type :initial - :static-init static-init}) - -(defn- int-init [v] - {:type :int-init - :value v}) - -(defn- long-init [v] - {:type :long-init - :value v}) - (defmulti typecheck-exp "Returns the expression, after typechecking nested expressions." (fn [{:keys [exp-type]} _ident->symbol] exp-type)) @@ -93,7 +64,7 @@ (set-type (p/cast-exp-node t e) t))) (defmethod typecheck-exp :binary-exp - [{:keys [left right binary-operator] :as e} ident->symbol] + [{: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)] @@ -113,7 +84,7 @@ (set-type typed-binary-exp {:type :int})))))) (defmethod typecheck-exp :assignment-exp - [{:keys [left right assignment-operator] :as e} ident->symbol] + [{:keys [left right assignment-operator] :as _e} ident->symbol] (let [typed-left (typecheck-exp left ident->symbol) typed-right (typecheck-exp right ident->symbol) @@ -130,7 +101,7 @@ 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 t-middle t-right)] + 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 @@ -194,14 +165,18 @@ [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 typed-body)) + {: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 typed-body)) + {: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] @@ -220,6 +195,9 @@ 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')] @@ -246,7 +224,7 @@ (defmethod typecheck-statement :compound [return-type {:keys [block]} m] (let [typed-block (typecheck-block return-type block m)] - {:statement (p/compound-statement-node typed-block) + {:statement (p/compound-statement-node (:block typed-block)) :ident->symbol (:ident->symbol typed-block)})) (defn- typecheck-item [return-type {:keys [type] :as item} m] @@ -274,8 +252,8 @@ (cond constant-exp? (to-static-init initial variable-type) (nil? initial) (if (= :extern storage-class) - (no-initializer-iv) - (tentative-iv)) + (sym/no-initializer-iv) + (sym/tentative-iv)) :else (exc/analyzer-error "Non-constant initializer." declaration)))) (defn- const-convert [{ttype :type :as _target-type} {const-type :type value :value :as const}] @@ -292,9 +270,9 @@ (cond (= :constant-exp exp-type) (let [c-const (const-convert var-type value)] (cond - (= :int (:type c-const)) (initial-iv (int-init (:value c-const))) - (= :long (:type c-const)) (initial-iv (long-init (:value c-const))))) - (nil? e) (initial-iv (int-init 0)) + (= :int (:type c-const)) (sym/initial-iv (sym/int-init (:value c-const))) + (= :long (:type c-const)) (sym/initial-iv (sym/long-init (:value c-const))))) + (nil? e) (sym/initial-iv (sym/int-init 0)) :else (exc/analyzer-error "Non-constant initializer on static variable." e))) (defn- validate-file-scope-variable-declaration @@ -336,7 +314,7 @@ {:declaration d :ident->symbol (assoc ident->symbol identifier - (create-symbol variable-type (static-attribute initial-value global?)))})) + (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] @@ -352,20 +330,20 @@ ident->symbol (assoc ident->symbol identifier - (create-symbol variable-type (static-attribute (no-initializer-iv) true))))] + (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 - (create-symbol variable-type (static-attribute initial-value false)))] + (sym/create-symbol variable-type (sym/static-attribute initial-value false)))] {:declaration d :ident->symbol updated-symbols}) (let [updated-symbols (assoc ident->symbol identifier - (create-symbol + (sym/create-symbol variable-type - (local-attribute))) + (sym/local-attribute))) casted-e (if (nil? initial) initial (convert-to-exp initial variable-type)) @@ -373,11 +351,6 @@ {:declaration (assoc d :initial t-e) :ident->symbol updated-symbols}))) -(defn- fun-attribute [defined? global?] - {:type :fun - :defined? defined? - :global? global?}) - (defn- validate-old-fn-decl-return-attribute [cur-decl prev-symbol] (let [prev-function? (= :function (get-in prev-symbol [:type :type])) @@ -410,7 +383,7 @@ ident->symbol (flatten (map (fn [p t] - [p (create-symbol t (local-attribute))]) + [p (sym/create-symbol t (sym/local-attribute))]) parameters (:parameter-types function-type)))))) @@ -423,10 +396,10 @@ (validate-old-fn-decl-return-attribute d prev-symbol) {:defined? false :global? (not= :static storage-class)}) - function-attribute (fun-attribute (boolean (or defined? body?)) global?) + function-attribute (sym/fun-attribute (boolean (or defined? body?)) global?) updated-symbols (assoc ident->symbol identifier - (create-symbol + (sym/create-symbol function-type function-attribute))] (if body? @@ -438,7 +411,7 @@ body (assoc with-parameter-symbols :at-top-level false))] - {:declaration d + {:declaration (assoc d :body (:block with-body-symbols)) :ident->symbol (assoc (:ident->symbol with-body-symbols) :at-top-level true)}) {:declaration d @@ -473,7 +446,8 @@ program (:program v) m (dissoc (:ident->symbol v) :at-top-level) _ (m/coerce s/Program program) - _ (m/coerce s/SymbolMap m)] + ;_ (m/coerce s/SymbolMap m) + ] {:program program :ident->symbol m})) diff --git a/src/cljcc/emit.clj b/src/cljcc/emit.clj index d753473..a0933c7 100644 --- a/src/cljcc/emit.clj +++ b/src/cljcc/emit.clj @@ -2,8 +2,7 @@ (:require [cljcc.util :refer [get-os]] [cljcc.compiler :as c] - [clojure.string :as str] - [cljcc.symbols :as symbols])) + [clojure.string :as str])) (defn- handle-label [identifier] (condp = (get-os) @@ -19,7 +18,8 @@ (defn- handle-current-translation-unit [name] (if (= :mac (get-os)) (handle-symbol-name name) - (if (contains? @symbols/symbols name) + (if (;check if sym exists inside symbol map + ) name (str name "@PLT")))) diff --git a/src/cljcc/parser.clj b/src/cljcc/parser.clj index 7e0ca06..6b9024f 100644 --- a/src/cljcc/parser.clj +++ b/src/cljcc/parser.clj @@ -3,6 +3,7 @@ [cljcc.lexer :as l] [cljcc.token :as t] [malli.core :as m] + [malli.dev.pretty :as pretty] [clojure.math :refer [pow]] [cljcc.schema :as s] [cljcc.exception :as exc] @@ -53,25 +54,30 @@ (defn function-call-exp-node [identifier arguments] {:type :exp :exp-type :function-call-exp + :children [:arguments] :identifier identifier - :arguments arguments}) + :arguments (vec arguments)}) (defn cast-exp-node [target-type e] {:type :exp :exp-type :cast-exp :target-type target-type + :typed-inner e ; copy of e, for use in tacky phase + :children [:value] :value e}) (defn unary-exp-node [op v] {:type :exp :exp-type :unary-exp :unary-operator op + :children [:value] :value v}) (defn binary-exp-node [l r op] {:type :exp :exp-type :binary-exp :binary-operator op + :children [:left :right] :left l :right r}) @@ -79,12 +85,14 @@ {:type :exp :exp-type :assignment-exp :assignment-operator op + :children [:left :right] :left l :right r}) (defn conditional-exp-node [l m r] {:type :exp :exp-type :conditional-exp + :children [:left :right :middle] :left l :middle m :right r}) @@ -484,7 +492,7 @@ (comment - (m/validate + (pretty/explain s/Program (parse-from-src "int main(void) { diff --git a/src/cljcc/schema.clj b/src/cljcc/schema.clj index 9084435..5f86dd8 100644 --- a/src/cljcc/schema.clj +++ b/src/cljcc/schema.clj @@ -52,7 +52,9 @@ [:type [:= :exp]] [:exp-type [:= :cast-exp]] [:target-type #'Type] + [:typed-inner [:ref #'Exp]] [:value [:ref #'Exp]] + [:children [:= [:value]]] [:value-type {:optional true} #'Type]]) (def UnaryExp @@ -61,6 +63,7 @@ [:exp-type [:= :unary-exp]] [:unary-operator `[:enum ~@t/unary-ops]] [:value [:ref #'Exp]] + [:children [:= [:value]]] [:value-type {:optional true} #'Type]]) (def BinaryExp @@ -70,6 +73,7 @@ [:binary-operator `[:enum ~@(set (keys t/bin-ops))]] [:left [:ref #'Exp]] [:right [:ref #'Exp]] + [:children [:= [:left :right]]] [:value-type {:optional true} #'Type]]) (def AssignmentExp @@ -77,6 +81,7 @@ [:type [:= :exp]] [:exp-type [:= :assignment-exp]] [:assignment-operator `[:enum ~@t/assignment-ops]] + [:children [:= [:left :right]]] [:left [:ref #'Exp]] [:right [:ref #'Exp]] [:value-type {:optional true} #'Type]]) @@ -85,6 +90,7 @@ [:map [:type [:= :exp]] [:exp-type [:= :conditional-exp]] + [:children [:= [:left :right :middle]]] [:left [:ref #'Exp]] [:middle [:ref #'Exp]] [:right [:ref #'Exp]] @@ -96,6 +102,7 @@ [:exp-type [:= :function-call-exp]] [:identifier string?] [:arguments [:vector [:ref #'Exp]]] + [:children [:= [:arguments]]] [:value-type {:optional true} #'Type]]) (def Exp @@ -316,3 +323,127 @@ [:map [:ident->symbol #'SymbolMap] [:program #'Program]]) + +(def TackyVar + [:map + [:type [:= :variable]] + [:value string?]]) + +(def TackyConstant + [:map + [:type [:= :constant]] + [:value #'Const]]) + +(def TackyVal + [:schema {:registry {::mtacky-var #'TackyVar + ::mtacky-constant #'TackyConstant}} + [:multi {:dispatch :type} + [:variable #'TackyVar] + [:constant #'TackyConstant]]]) + +(def TackyReturn + [:map + [:type [:= :return]] + [:val #'TackyVal]]) + +(def TackySignExtend + [:map + [:type [:= :sign-extend]] + [:src #'TackyVal] + [:dst #'TackyVal]]) + +(def TackyTruncate + [:map + [:type [:= :truncate]] + [:src #'TackyVal] + [:dst #'TackyVal]]) + +(def TackyUnary + [:map + [:type [:= :unary]] + [:unary-operator `[:enum ~@t/tacky-unary-ops]] + [:src #'TackyVal] + [:dst #'TackyVal]]) + +(def TackyBinary + [:map + [:type [:= :binary]] + [:binary-operator `[:enum ~@t/tacky-binary-ops]] + [:src1 #'TackyVal] + [:src2 #'TackyVal] + [:dst #'TackyVal]]) + +(def TackyCopy + [:map + [:type [:= :copy]] + [:src #'TackyVal] + [:dst #'TackyVal]]) + +(def TackyJump + [:map + [:type [:= :jump]] + [:identifier string?]]) + +(def TackyJumpIfZero + [:map + [:type [:= :jump-if-zero]] + [:val #'TackyVal] + [:identifier string?]]) + +(def TackyJumpIfNotZero + [:map + [:type [:= :jump-if-not-zero]] + [:val #'TackyVal] + [:identifier string?]]) + +(def TackyLabel + [:map + [:type [:= :label]] + [:identifier string?]]) + +(def TackyFunCall + [:map + [:type [:= :fun-call]] + [:identifier string?] + [:arguments [:vector #'TackyVal]] + [:dst #'TackyVal]]) + +(def TackyInstruction + [:multi {:dispatch :type} + [:return #'TackyReturn] + [:sign-extend #'TackySignExtend] + [:truncate #'TackyTruncate] + [:unary #'TackyUnary] + [:binary #'TackyBinary] + [:copy #'TackyCopy] + [:jump #'TackyJump] + [:jump-if-zero #'TackyJumpIfZero] + [:jump-if-not-zero #'TackyJumpIfNotZero] + [:label #'TackyLabel] + [:fun-call #'TackyFunCall]]) + +(def TackyFunction + [:map + [:identifier string?] + [:global? boolean?] + [:type [:= :declaration]] + [:declaration-type [:= :function]] + [:parameters [:vector string?]] + [:instructions [:vector #'TackyInstruction]]]) + +(def TackyStaticVariable + [:map + [:identifier string?] + [:global? boolean?] + [:variable-type #'Type] + [:initial #'Initial] + [:declaration-type [:= :static-variable]] + [:type [:= :declaration]]]) + +(def TackyTopLevel + [:multi {:dispatch :declaration-type} + [:static-variable #'TackyStaticVariable] + [:function #'TackyFunction]]) + +(def TackyProgram + [:vector #'TackyTopLevel]) diff --git a/src/cljcc/symbol.clj b/src/cljcc/symbol.clj new file mode 100644 index 0000000..3cc4af9 --- /dev/null +++ b/src/cljcc/symbol.clj @@ -0,0 +1,38 @@ +(ns cljcc.symbol) + +;; Contains functions related to symbol table manipulation. + +(defn create-symbol [type attribute] + {:type type + :attribute attribute}) + +(defn local-attribute [] + {:type :local}) + +(defn static-attribute [initial-value global?] + {:type :static + :initial-value initial-value + :global? global?}) + +(defn fun-attribute [defined? global?] + {:type :fun + :defined? defined? + :global? global?}) + +(defn no-initializer-iv [] + {:type :no-initializer}) + +(defn tentative-iv [] + {:type :tentative}) + +(defn initial-iv [static-init] + {:type :initial + :static-init static-init}) + +(defn int-init [v] + {:type :int-init + :value v}) + +(defn long-init [v] + {:type :long-init + :value v}) diff --git a/src/cljcc/symbols.clj b/src/cljcc/symbols.clj deleted file mode 100644 index 1afbe47..0000000 --- a/src/cljcc/symbols.clj +++ /dev/null @@ -1,10 +0,0 @@ -(ns cljcc.symbols) - -(def symbols - "Holds global symbol table. - - Maps identifiers to their types." - (atom {})) - -(defn reset-symbols [new-symbols] - (reset! symbols new-symbols)) diff --git a/src/cljcc/tacky.clj b/src/cljcc/tacky.clj index b19dacd..8f87165 100644 --- a/src/cljcc/tacky.clj +++ b/src/cljcc/tacky.clj @@ -4,7 +4,14 @@ [cljcc.util :as u] [cljcc.parser :as p] [cljcc.exception :as exc] - [cljcc.analyze.core :as a])) + [cljcc.symbol :as sym] + [cljcc.analyze.resolve :as r] + [cljcc.analyze.label-loops :as label-loop] + [malli.dev.pretty :as pretty] + [cljcc.analyze.typecheck :as tc] + [cljcc.analyze.core :as a] + [malli.core :as m] + [cljcc.schema :as s])) (defn- variable ([] @@ -17,14 +24,26 @@ {:type :variable :value (:identifier v)}) +(defn tacky-var [identifier] + {:type :variable + :value identifier}) + (defn- label ([] (label "label")) ([ident] (u/create-identifier! ident))) -(defn constant [^Integer v] - {:type :constant +(defn- const-int [v] + {:type :int + :value v}) + +(defn- const-long [v] + {:type :long :value v}) +(defn constant [const-value] + {:type :constant + :value const-value}) + (defn- unary-operator "Converts parser's unary operator to tacky representation." [op] @@ -48,7 +67,8 @@ :assignment-bitwise-or :bitwise-or :assignment-bitwise-xor :bitwise-xor :assignment-bitwise-left-shift :bitwise-left-shift - :assignment-bitwise-right-shift :bitwise-right-shift)) + :assignment-bitwise-right-shift :bitwise-right-shift + (exc/tacky-error "Invalid assignment operator." op))) (defn- binary-operator "Converts parser's binary operator to tacky representation." @@ -70,7 +90,7 @@ :bitwise-xor :bit-xor :bitwise-right-shift :bit-right-shift :bitwise-left-shift :bit-left-shift - (throw (ex-info "Tacky Error. Invalid binary operator." {binop binop})))) + (exc/tacky-error "Invalid binary operator." binop))) ;;;; Instructions @@ -91,6 +111,16 @@ {:type :return :val val}) +(defn- sign-extend-instruction [src dst] + {:type :sign-extend + :src src + :dst dst}) + +(defn- truncate-instruction [src dst] + {:type :truncate + :src src + :dst dst}) + (defn- copy-instruction [src dst] {:type :copy :src src @@ -122,138 +152,230 @@ ;;;; Expression handlers -(declare expression-handler) +;; Timothy Baldridge, Data all the ASTs +(defn postwalk [ast f] + (f (reduce + (fn [acc key] + (let [value (get acc key)] + (if (vector? value) + (assoc acc key (doall (map (fn [node] (postwalk node f)) + value))) + (assoc acc key (postwalk value f))))) + ast + (:children ast)))) + +(defn- add-var-to-symbol [var var-type symbols] + (swap! symbols assoc (:value var) {:type var-type + :attribute (sym/local-attribute)})) + +(defmulti exp-handler + (fn [exp _symbols] + (:exp-type exp))) -(defn- constant-expr-handler [e] - {:val (constant (:value e))}) +(comment -(defn- unary-expr-handler [e] - (let [inner (expression-handler (:value e)) - src (:val inner) - op (unary-operator (:unary-operator e)) + (exp-handler + {:type :exp, + :exp-type :function-call-exp, + :children [:arguments], + :identifier "foo", + :arguments [], + :value-type {:type :long}} + (atom {})) + + ()) + +(comment + + (exp-handler + {:type :exp, + :exp-type :variable-exp, + :identifier "x.5", + :value-type {:type :int}} + (atom {})) + + ()) + +(defmethod exp-handler :default + [_ _] + {:instructions []}) + +(defmethod exp-handler :constant-exp + [exp _] + {:val (constant (:value exp))}) + +(defmethod exp-handler :variable-exp + [exp _] + {:val (tacky-var (:identifier exp))}) + +(defmethod exp-handler :cast-exp + [{:keys [target-type value typed-inner]} symbols] + (if (= target-type (tc/get-type typed-inner)) + value + (let [dst (variable "cast_") + _ (add-var-to-symbol dst target-type symbols) + {res :val + insts :instructions} value] + (if (= :long (:type target-type)) + {:val dst + :instructions (flatten [insts + (sign-extend-instruction res dst)])} + {:val dst + :instructions (flatten [insts + (truncate-instruction res dst)])})))) + +(defmethod exp-handler :unary-exp + [exp symbols] + (let [{src :val + insts :instructions} (:value exp) + op (unary-operator (:unary-operator exp)) dst (variable (str "unary_result_" op)) - instruction (unary-instruction op src dst)] + _ (add-var-to-symbol dst (tc/get-type exp) symbols) + inst (unary-instruction op src dst)] {:val dst - :instructions (flatten [(:instructions inner) instruction])})) - -(defn- binary-expr-handler [e] - (let [e1 (expression-handler (:left e)) - e2 (expression-handler (:right e)) - src1 (:val e1) - src2 (:val e2) - op (binary-operator (:binary-operator e)) - dst (variable (str "binary_result_" op)) - instruction (binary-instruction op src1 src2 dst)] - {:val dst - :instructions (flatten [(:instructions e1) (:instructions e2) instruction])})) - -(defn- logical-and-handler [e] - (let [e1 (expression-handler (:left e)) - e2 (expression-handler (:right e)) - v1 (:val e1) - v2 (:val e2) + :instructions (flatten [insts inst])})) + +(defn logical-and-binary-handler + [exp symbols] + (let [{v1 :val + insts1 :instructions} (:left exp) + {v2 :val + insts2 :instructions} (:right exp) res (variable "and_result") + _ (add-var-to-symbol res (tc/get-type exp) symbols) false-label (label "and_false") end-label (label "and_end")] {:val res - :instructions (flatten [(:instructions e1) + :instructions (flatten [insts1 (jump-if-zero-instruction v1 false-label) - (:instructions e2) + insts2 (jump-if-zero-instruction v2 false-label) - (copy-instruction (constant 1) res) + (copy-instruction (constant (const-int 1)) res) (jump-instruction end-label) (label-instruction false-label) - (copy-instruction (constant 0) res) + (copy-instruction (constant (const-int 0)) res) (label-instruction end-label)])})) -(defn- logical-or-handler [e] - (let [e1 (expression-handler (:left e)) - e2 (expression-handler (:right e)) - v1 (:val e1) - v2 (:val e2) +(defn logical-or-binary-handler + [exp symbols] + (let [{v1 :val + insts1 :instructions} (:left exp) + {v2 :val + insts2 :instructions} (:right exp) res (variable "or_result") + _ (add-var-to-symbol res (tc/get-type exp) symbols) false-label (label "or_false") end-label (label "or_end")] {:val res - :instructions (flatten [(:instructions e1) + :instructions (flatten [insts1 (jump-if-not-zero-instruction v1 end-label) - (:instructions e2) + insts2 (jump-if-not-zero-instruction v2 end-label) - (copy-instruction (constant 0) res) + (copy-instruction (constant (const-int 0)) res) (jump-instruction false-label) (label-instruction end-label) - (copy-instruction (constant 1) res) + (copy-instruction (constant (const-int 1)) res) (label-instruction false-label)])})) -(defn- assignment-exp-handler [e] - (let [asop (:assignment-operator e) - direct-assignment? (= asop :assignment) - var (parsed-var->tacky-var (:left e))] ; guaranteed to be parsed variable +(defn binary-exp-handler + [exp symbols] + (let [{v1 :val + insts1 :instructions} (:left exp) + {v2 :val + insts2 :instructions} (:right exp) + op (binary-operator (:binary-operator exp)) + dst (variable (str "binary_result_" op)) + _ (add-var-to-symbol dst (tc/get-type exp) symbols) + binary-inst (binary-instruction op v1 v2 dst)] + {:val dst + :instructions (flatten [insts1 + insts2 + binary-inst])})) + +(defmethod exp-handler :binary-exp + [exp symbols] + (let [op (:binary-operator exp)] + (condp = op + :logical-and (logical-and-binary-handler exp symbols) + :logical-or (logical-or-binary-handler exp symbols) + (binary-exp-handler exp symbols)))) + +(defmethod exp-handler :assignment-exp + [exp symbols] + (let [op (:assignment-operator exp) + var (:val (:left exp)); guaranteed to be a TackyVariable + direct-assignment? (= op :assignment)] (if direct-assignment? - (let [rhs (expression-handler (:right e))] + (let [{dst :val + insts :instructions} (:right exp)] {:val var - :instructions (flatten [(:instructions rhs) - (copy-instruction (:val rhs) var)])}) - (let [bin-op (assignment-operator->binary-operator (:assignment-operator e)) - bin-exp (p/binary-exp-node (:left e) (:right e) bin-op) - rhs (expression-handler bin-exp)] - {:val var - :instructions (flatten [(:instructions rhs) - (copy-instruction (:val rhs) var)])})))) - -(defn- conditional-exp-handler [e] - (let [ce (expression-handler (:left e)) - cv (:val ce) - then-e (expression-handler (:middle e)) - else-e (expression-handler (:right e)) - end-label (label "conditional_end") + :instructions (flatten [insts + (copy-instruction dst var)])}) + (let [bin-op (assignment-operator->binary-operator op) + bin-exp (p/binary-exp-node (:left exp) (:right exp) bin-op) + {rhs :val + insts :instructions} (exp-handler bin-exp symbols)] + {:val rhs + :instructions (flatten [insts + (copy-instruction rhs var)])})))) + +(defmethod exp-handler :conditional-exp + [exp symbols] + (let [{condition-val :val + condition-insts :instructions} (:left exp) + {then-val :val + then-insts :instructions} (:middle exp) + {else-val :val + else-insts :instructions} (:right exp) + end-label (label "condition_end") else-label (label "conditional_else") - res (variable "conditional_result")] + res (variable "conditional_result") + _ (add-var-to-symbol res (tc/get-type exp) symbols)] {:val res - :instructions (flatten - [(:instructions ce) - (jump-if-zero-instruction cv else-label) - (:instructions then-e) - (copy-instruction (:val then-e) res) - (jump-instruction end-label) - (label-instruction else-label) - (:instructions else-e) - (copy-instruction (:val else-e) res) - (label-instruction end-label)])})) - -(defn- function-call-exp-handler [{identifier :identifier arguments :arguments}] - (let [arg-exps (mapv expression-handler arguments) - dst (variable (str "function_call_result_" identifier)) - fn-instruction (fun-call-instruction identifier (mapv #(:val %) arg-exps) dst)] + :instructions (flatten [condition-insts + (jump-if-zero-instruction condition-val else-label) + then-insts + (copy-instruction then-val res) + (jump-instruction end-label) + (label-instruction else-label) + else-insts + (copy-instruction else-val res) + (label-instruction end-label)])})) + +(defmethod exp-handler :function-call-exp + [{identifier :identifier + arguments :arguments :as exp} symbols] + (let [dst (variable (str "function_call_result_" identifier)) + _ (add-var-to-symbol dst (tc/get-type exp) symbols) + fn-instruction (fun-call-instruction identifier + (mapv #(:val %) arguments) + dst)] {:val dst - :instructions (flatten [(mapv #(:instructions %) arg-exps) fn-instruction])})) - -(defn- expression-handler [e] - (when-let [exp-type (:exp-type e)] - (condp = exp-type - :constant-exp (constant-expr-handler e) - :unary-exp (unary-expr-handler e) - :binary-exp (let [op (:binary-operator e)] - (condp = op - :logical-and (logical-and-handler e) - :logical-or (logical-or-handler e) - (binary-expr-handler e))) - :variable-exp {:val (parsed-var->tacky-var e)} - :assignment-exp (assignment-exp-handler e) - :conditional-exp (conditional-exp-handler e) - :function-call-exp (function-call-exp-handler e) - (throw (ex-info "Tacky error. Invalid expression." {e e}))))) - -(defn- exp-instructions [exp] - (expression-handler exp)) + :instructions (flatten [(mapv #(:instructions %) arguments) + fn-instruction])})) + +(defn run-expression-handler + "Transforms a expression to tacky variable and instructions. + + Parameters: + exp: Expression to be parsed + symbols: Atom for symbol map" + [exp symbols] + (postwalk exp #(exp-handler % symbols))) + +(comment + + ()) + +;;;; Statement Handlers (declare statement->tacky-instruction block-item->tacky-instruction) -(defn if-statement-handler [s] - (let [cond-exp (exp-instructions (:condition s)) +(defn if-statement-handler [s symbols] + (let [cond-exp (run-expression-handler (:condition s) symbols) cond-value (:val cond-exp) cond-instructions (:instructions cond-exp) - then-instructions (statement->tacky-instruction (:then-statement s)) + then-instructions (statement->tacky-instruction (:then-statement s) symbols) end-label (label "if_end") else-label (label "if_else") else? (:else-statement s)] @@ -263,29 +385,29 @@ then-instructions (jump-instruction end-label) (label-instruction else-label) - (statement->tacky-instruction (:else-statement s)) + (statement->tacky-instruction (:else-statement s) symbols) (label-instruction end-label)] [cond-instructions (jump-if-zero-instruction cond-value end-label) then-instructions (label-instruction end-label)]))) -(defn- compound-statement-handler [s] - (flatten (mapv block-item->tacky-instruction (:block s)))) +(defn- compound-statement-handler [s symbols] + (flatten (mapv #(block-item->tacky-instruction % symbols) (:block s)))) -(defn- break-statement-handler [s] +(defn- break-statement-handler [s _] [(jump-instruction (str "break_" (:label s)))]) -(defn- continue-statement-handler [s] +(defn- continue-statement-handler [s _] [(jump-instruction (str "continue_" (:label s)))]) -(defn- while-statement-handler [s] +(defn- while-statement-handler [s symbols] (let [continue-label (str "continue_" (:label s)) break-label (str "break_" (:label s)) - cond-exp (exp-instructions (:condition s)) + cond-exp (run-expression-handler (:condition s) symbols) cond-value (:val cond-exp) cond-instructions (:instructions cond-exp) - body-instructions (statement->tacky-instruction (:body s))] + body-instructions (statement->tacky-instruction (:body s) symbols)] (flatten [(label-instruction continue-label) cond-instructions (jump-if-zero-instruction cond-value break-label) @@ -293,14 +415,14 @@ (jump-instruction continue-label) (label-instruction break-label)]))) -(defn- do-while-statement-handler [s] +(defn- do-while-statement-handler [s symbols] (let [start-label (label "do_while_start") continue-label (str "continue_" (:label s)) break-label (str "break_" (:label s)) - cond-exp (exp-instructions (:condition s)) + cond-exp (run-expression-handler (:condition s) symbols) cond-value (:val cond-exp) cond-instructions (:instructions cond-exp) - body-instructions (statement->tacky-instruction (:body s))] + body-instructions (statement->tacky-instruction (:body s) symbols)] (flatten [(label-instruction start-label) body-instructions (label-instruction continue-label) @@ -308,20 +430,20 @@ (jump-if-not-zero-instruction cond-value start-label) (label-instruction break-label)]))) -(defn- for-statement-handler [s] +(defn- for-statement-handler [s symbols] (let [init-instructions (if (= :declaration (:type (:init s))) - (block-item->tacky-instruction (:init s)) - (:instructions (exp-instructions (:init s)))) + (block-item->tacky-instruction (:init s) symbols) + (:instructions (run-expression-handler (:init s) symbols))) start-label (label "for_start") break-label (str "break_" (:label s)) continue-label (str "continue_" (:label s)) cond? (not (nil? (:condition s))) - body-instructions (statement->tacky-instruction (:body s)) + body-instructions (statement->tacky-instruction (:body s) symbols) post-instructions (if (nil? (:post s)) [] - (:instructions (exp-instructions (:post s)))) + (:instructions (run-expression-handler (:post s) symbols))) cond-instructions (if cond? - (let [ce (exp-instructions (:condition s)) + (let [ce (run-expression-handler (:condition s) symbols) ce-inst (:instructions ce) ce-v (:val ce)] [ce-inst @@ -337,90 +459,99 @@ (jump-instruction start-label) (label-instruction break-label)]))) -(defn- statement->tacky-instruction [s] +(defn- statement->tacky-instruction [s symbols] (condp = (:statement-type s) - :return (let [e (exp-instructions (:value s)) + :return (let [e (run-expression-handler (:value s) symbols) val (:val e) instructions (:instructions e)] (conj (vec instructions) (return-instruction val))) - :expression [(:instructions (exp-instructions (:value s)))] - :if (if-statement-handler s) - :compound (compound-statement-handler s) - :break (break-statement-handler s) - :continue (continue-statement-handler s) - :for (for-statement-handler s) - :while (while-statement-handler s) - :do-while (do-while-statement-handler s) + :expression [(:instructions (run-expression-handler (:value s) symbols))] + :if (if-statement-handler s symbols) + :compound (compound-statement-handler s symbols) + :break (break-statement-handler s symbols) + :continue (continue-statement-handler s symbols) + :for (for-statement-handler s symbols) + :while (while-statement-handler s symbols) + :do-while (do-while-statement-handler s symbols) :empty [] - (throw (ex-info "Tacky error. Invalid statement." {:statement s})))) + (exc/tacky-error "Invalid statement" s))) -(defn- declaration->tacky-instruction [d] +(defn- declaration->tacky-instruction [d symbols] (when (:initial d) (let [local? (nil? (:storage-class d)) var (parsed-var->tacky-var d) ; only needs :identifier key in declaration - rhs (exp-instructions (:initial d))] + rhs (run-expression-handler (:initial d) symbols)] (if local? (flatten [(:instructions rhs) (copy-instruction (:val rhs) var)]) [])))) ; ignoring initializers for non local variable declarations -(defn- block-item->tacky-instruction [item] +(defn- block-item->tacky-instruction [item symbols] (condp = (:type item) - :statement (statement->tacky-instruction item) - :declaration (declaration->tacky-instruction item) - (throw (ex-info "Tacky error. Invalid block item." {:item item})))) + :statement (statement->tacky-instruction item symbols) + :declaration (declaration->tacky-instruction item symbols) + (exc/tacky-error "Invalid block item." item))) -(defn- function-definition->tacky-function [function-definition ident->symbol] - (let [add-return (fn [xs] (conj (vec xs) (return-instruction (constant 0)))) +(defn- function-definition->tacky-function [function-definition symbols] + (let [add-return (fn [xs] (conj (vec xs) (return-instruction (constant {:type :int :value 0})))) instructions (->> function-definition :body (remove nil?) - (mapv block-item->tacky-instruction) + (mapv #(block-item->tacky-instruction % symbols)) flatten (remove nil?) add-return)] (-> function-definition (dissoc :body) - (assoc :global? (get-in ident->symbol [(:identifier function-definition) - :attrs - :global?])) + (assoc :global? (get-in @symbols [(:identifier function-definition) + :attribute + :global?])) (assoc :instructions instructions)))) -(defn- tacky-static-variable [identifier global? variable-type initial-value] +(defn- tacky-static-variable [identifier global? variable-type initial] {:identifier identifier :global? global? - :initial-value initial-value + :initial initial :type :declaration :variable-type variable-type :declaration-type :static-variable}) -(defn- tacky-static-variable-instructions [ident->symbols] - (reduce - (fn [acc [k v]] - (if (string? k) - (if (= :static (get-in v [:attrs :type])) - (condp = (get-in v [:attrs :initial-value :type]) - :initial (conj acc (tacky-static-variable k (get-in v [:attrs :global?]) (get-in v [:attrs :initial-value :value]))) - :tentative (conj acc (tacky-static-variable k (get-in v [:attrs :global?]) 0)) - acc) - acc) - acc)) - [] - ident->symbols)) - -(defn- tacky-function-instructions [ast ident->symbol] +(defn- tacky-static-variable-instructions + "Generates list of tacky static variable from symbol map." + [ident->symbol] + (let [rf (fn [acc [k v]] + (if (= :static (get-in v [:attribute :type])) + (let [vtype (get-in v [:type]) + global? (get-in v [:attribute :global?]) + initial (get-in v [:attribute :initial-value]) + tentative-initial (if (= :int (:type vtype)) + (sym/initial-iv (sym/int-init 0)) + (sym/initial-iv (sym/long-init 0))) + itype (get-in v [:attribute :initial-value :type])] + (condp = itype + :initial (conj acc (tacky-static-variable k global? vtype initial)) + :tentative (conj acc (tacky-static-variable k global? vtype tentative-initial)) + acc)) + acc))] + (reduce rf [] ident->symbol))) + +(defn- tacky-function-instructions [ast symbols] (let [fn-defined? (fn [x] (if (= :function (:declaration-type x)) (or (= (:identifier x) "main") (seq (:body x))) true))] (->> ast (filterv #(= :function (:declaration-type %))) (filterv fn-defined?) - (mapv #(function-definition->tacky-function % ident->symbol))))) + (mapv #(function-definition->tacky-function % symbols))))) -(defn tacky-generate [{ast :block ident->symbol :ident->symbol}] +(defn tacky-generate [{ast :program ident->symbol :ident->symbol}] (let [variable-instructions (tacky-static-variable-instructions ident->symbol) - function-instructions (tacky-function-instructions ast ident->symbol)] - {:program (concat variable-instructions function-instructions) - :ident->symbol ident->symbol})) + symbols (atom ident->symbol) + function-instructions (tacky-function-instructions ast symbols) + program (vec (concat variable-instructions function-instructions)) + _ (m/coerce s/TackyProgram program) + _ (m/coerce s/SymbolMap @symbols)] + {:program program + :ident->symbol @symbols})) (defn tacky-from-src [src] (-> src @@ -431,6 +562,55 @@ (comment + (def tmp + " +long foo(void) { + return 1; +} + +int bar(int x, int y) { + return x + y; +} + +int main(void) { +int x = 6; +return (long) foo() + 2 + x + bar(x, 7) + (3 ? 4 : 5); + +}") + + (-> tmp + l/lex + p/parse + a/validate) + + (tacky-from-src tmp) + + ()) + +(comment + + (def ex " +long foo(void) { + return 1; +} + +int bar(int x, int y) { + return x + y; +} + +int main(void) { +int x = 6; +return (long) foo() + 2 + x + bar(x, 7) + (3 ? 4 : 5); +}") + + (-> ex + l/lex + p/parse + a/validate) + + (tacky-from-src + "int main(void) { return 42; }") + (tacky-from-src " extern int foo; @@ -449,4 +629,34 @@ int foo; ") + (def file-path "./test-programs/example.c") + + (slurp "./test-programs/example.c") + + (-> file-path + slurp + p/parse-from-src + a/validate) + + (-> file-path + slurp + p/parse-from-src + a/validate + tacky-generate) + + (pretty/explain + s/TackyProgram + (-> file-path + slurp + p/parse-from-src + a/validate + tacky-generate + :program)) + + (-> file-path + slurp + p/parse-from-src + a/validate + tacky-generate) + ()) diff --git a/src/cljcc/token.clj b/src/cljcc/token.clj index 86231b8..3eaa505 100644 --- a/src/cljcc/token.clj +++ b/src/cljcc/token.clj @@ -213,3 +213,24 @@ :line line :col col :literal literal})) + +(def tacky-unary-ops + #{:bit-not :negate :logical-not}) + +(def tacky-binary-ops + #{:add + :sub + :mul + :div + :mod + :equal + :not-equal + :less-than + :greater-than + :less-or-equal + :greater-or-equal + :bit-and + :bit-or + :bit-xor + :bit-right-shift + :bit-left-shift}) |