diff options
| -rw-r--r-- | src/cljcc/analyze/typecheck.clj | 122 | ||||
| -rw-r--r-- | src/cljcc/compiler.clj | 4 | ||||
| -rw-r--r-- | src/cljcc/schema.clj | 4 | ||||
| -rw-r--r-- | src/cljcc/tacky.clj | 44 | ||||
| -rw-r--r-- | src/cljcc/util.clj | 3 |
5 files changed, 106 insertions, 71 deletions
diff --git a/src/cljcc/analyze/typecheck.clj b/src/cljcc/analyze/typecheck.clj index 7c2c694..d1e79dc 100644 --- a/src/cljcc/analyze/typecheck.clj +++ b/src/cljcc/analyze/typecheck.clj @@ -84,24 +84,24 @@ (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})))))) + (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] @@ -111,7 +111,7 @@ 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))) + (set-type typed-assign-exp left-type))) (defmethod typecheck-exp :conditional-exp [{:keys [left right middle] :as _e} m] @@ -128,21 +128,21 @@ [{: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})))) + (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. @@ -282,25 +282,25 @@ 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}))) + [: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." @@ -495,9 +495,9 @@ (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)] - + ;_ (m/coerce s/Program program) + ;_ (m/coerce s/SymbolMap m) + ] {:program program :ident->symbol m})) @@ -519,11 +519,11 @@ typecheck) (-> - "unsigned long ul = 18446744073709549568.;" - 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 diff --git a/src/cljcc/compiler.clj b/src/cljcc/compiler.clj index d8c1520..39b3506 100644 --- a/src/cljcc/compiler.clj +++ b/src/cljcc/compiler.clj @@ -832,10 +832,10 @@ (mapv #(tacky-function->assembly-function % ident->symbol))) backend-symbol-table (backend-symbol-table ident->symbol) fixed-assembly-functions (mapv #(fix-assembly-function % backend-symbol-table) assembly-functions) - program (vec (flatten [assembly-static-variables fixed-assembly-functions])) + program (vec (flatten [assembly-static-variables fixed-assembly-functions]))] ;_ (m/coerce schema/AssemblyProgram program) ;_ (m/coerce schema/BackendSymbolMap backend-symbol-table) - ] + {:program program :backend-symbol-table backend-symbol-table})) diff --git a/src/cljcc/schema.clj b/src/cljcc/schema.clj index ebddad4..bf216f9 100644 --- a/src/cljcc/schema.clj +++ b/src/cljcc/schema.clj @@ -479,6 +479,10 @@ [:sign-extend #'TackySignExtend] [:truncate #'TackyTruncate] [:zero-extend #'TackyZeroExtend] + [:double-to-int #'TackyDoubleToInt] + [:double-to-uint #'TackyDoubleToUInt] + [:int-to-double #'TackyIntToDouble] + [:uint-to-double #'TackyUIntToDouble] [:unary #'TackyUnary] [:binary #'TackyBinary] [:copy #'TackyCopy] diff --git a/src/cljcc/tacky.clj b/src/cljcc/tacky.clj index 9e1961a..be60841 100644 --- a/src/cljcc/tacky.clj +++ b/src/cljcc/tacky.clj @@ -124,6 +124,26 @@ :src src :dst dst}) +(defn- double-to-int-instruction [src dst] + {:type :double-to-int + :src src + :dst dst}) + +(defn- double-to-uint-instruction [src dst] + {:type :double-to-uint + :src src + :dst dst}) + +(defn- int-to-double-instruction [src dst] + {:type :int-to-double + :src src + :dst dst}) + +(defn- uint-to-double-instruction [src dst] + {:type :uint-to-double + :src src + :dst dst}) + (defn- copy-instruction [src dst] {:type :copy :src src @@ -196,15 +216,21 @@ inner-type (tc/get-type typed-inner) {res :val insts :instructions} value - cast-i (cond - (= (u/get-type-size target-type) - (u/get-type-size inner-type)) (copy-instruction res dst) - (< (u/get-type-size target-type) - (u/get-type-size inner-type)) (truncate-instruction res dst) - (u/type-signed? inner-type) (sign-extend-instruction res dst) - :else (zero-extend-instruction res dst))] + cast-inst (cond + (u/type-double? target-type) (if (u/type-signed? inner-type) + (int-to-double-instruction res dst) + (uint-to-double-instruction res dst)) + (u/type-double? inner-type) (if (u/type-signed? target-type) + (double-to-int-instruction res dst) + (double-to-uint-instruction res dst)) + (= (u/get-type-size target-type) + (u/get-type-size inner-type)) (copy-instruction res dst) + (< (u/get-type-size target-type) + (u/get-type-size inner-type)) (truncate-instruction res dst) + (u/type-signed? inner-type) (sign-extend-instruction res dst) + :else (zero-extend-instruction res dst))] {:val dst - :instructions (flatten [insts cast-i])}))) + :instructions (flatten [insts cast-inst])}))) (defmethod exp-handler :unary-exp [exp symbols] @@ -599,6 +625,8 @@ int foo; int foo; int main(void) { + double x = 1000; + for (int i = 0; i < 5; i = i + 1) foo = foo + 1; return foo; diff --git a/src/cljcc/util.clj b/src/cljcc/util.clj index 351b11f..4c56ab9 100644 --- a/src/cljcc/util.clj +++ b/src/cljcc/util.clj @@ -149,6 +149,9 @@ {:type :ulong} 10 (exc/analyzer-error "Invalid type passed to get-type-size." {:type t}))) +(defn type-double? [t] + (= {:type :double} t)) + (defn type-signed? [t] (condp = t {:type :int} true |