aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/cljcc/analyze/typecheck.clj66
-rw-r--r--src/cljcc/lexer.clj23
-rw-r--r--src/cljcc/parser.clj31
-rw-r--r--src/cljcc/schema.clj2
-rw-r--r--src/cljcc/util.clj17
5 files changed, 87 insertions, 52 deletions
diff --git a/src/cljcc/analyze/typecheck.clj b/src/cljcc/analyze/typecheck.clj
index e042adc..52bc4e0 100644
--- a/src/cljcc/analyze/typecheck.clj
+++ b/src/cljcc/analyze/typecheck.clj
@@ -58,6 +58,8 @@
(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
@@ -78,20 +80,20 @@
(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)
- 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)
+ 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]
@@ -101,7 +103,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]
@@ -118,21 +120,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.
@@ -480,10 +482,10 @@
[program]
(let [v (typecheck-program program)
program (:program v)
- m (dissoc (:ident->symbol v) :at-top-level)
+ m (dissoc (:ident->symbol v) :at-top-level)]
;_ (m/coerce s/Program program)
;_ (m/coerce s/SymbolMap m)
- ]
+
{:program program
:ident->symbol m}))
diff --git a/src/cljcc/lexer.clj b/src/cljcc/lexer.clj
index d4e20d3..ef4235f 100644
--- a/src/cljcc/lexer.clj
+++ b/src/cljcc/lexer.clj
@@ -67,12 +67,31 @@
slurp
lex)
- (lex "int x = 100;")
+ (lex "int x = 100l;")
+
+ (lex "
+ if (!sign_extend(10, 10l)) {
+ return 1;
+ }
+")
+
(lex
"
int main(void) {
- return 2- -1;
+ if (!sign_extend(10, 10l)) {
+ return 1;
+ }
+
+ if (!sign_extend(-10, -10l)) {
+ return 2;
+ }
+
+ long l = (long) 100;
+ if (l != 100l) {
+ return 3;
+ }
+ return 0;
}
")
diff --git a/src/cljcc/parser.clj b/src/cljcc/parser.clj
index 7837ce3..f8d039d 100644
--- a/src/cljcc/parser.clj
+++ b/src/cljcc/parser.clj
@@ -107,6 +107,8 @@
has-duplicates? (fn [coll] (some (fn [[_ c]] (> c 1)) (frequencies coll)))
spec-set (set specifiers)]
(cond
+ (= specifiers [:double]) :double
+ (some #{:double} specifiers) (exc/parser-error "Cannot combine double with other specifiers." {:specifiers specifiers})
(has-duplicates? specifiers) (exc/parser-error "Invalid specifiers" {:specifiers specifiers})
(empty? specifiers) (exc/parser-error "Invalid specifiers" {:specifiers specifiers})
(and (spec-set :signed)
@@ -117,16 +119,11 @@
(spec-set :long) :long
:else :int)))
-(comment
-
- (parse-type '(:long :int :int :signed :unsigned))
-
- ())
-
(defn specifier-node [{:keys [kind] :as token}]
(let [specifier-type (condp = kind
:kw-int :int
:kw-long :long
+ :kw-double :double
:kw-static :static
:kw-extern :extern
:kw-unsigned :unsigned
@@ -157,7 +154,7 @@
(defn- parse-signed-const [v]
(let [n (re-find #"[0-9]+" v)
- long? (u/matches-regex u/signed-long-re v)
+ long? (u/matches-regex u/signed-long-re-without-wordbreak v)
in-long-range? (try (Long/parseLong n) (catch Exception _e false))
in-int-range? (<= (Long/parseLong n) Integer/MAX_VALUE)
_ (when (not in-long-range?)
@@ -170,7 +167,7 @@
(defn- parse-unsigned-const [v]
(let [n (re-find #"[0-9]+" v)
- ulong? (u/matches-regex u/unsigned-long-re v)
+ ulong? (u/matches-regex u/unsigned-long-re-without-wordbreak v)
in-ulong-range? (try (Long/parseUnsignedLong n) (catch Exception _e false))
in-uint-range? (<= (Long/compareUnsigned (Long/parseUnsignedLong n) (Long/parseUnsignedLong "4294967295")) 0)
_ (when (not in-ulong-range?)
@@ -181,12 +178,17 @@
{:type :ulong
:value (Long/parseUnsignedLong n)})))
+(defn- parse-double-num [v]
+ {:type :double
+ :value (Double/parseDouble v)})
+
(defn- parse-const [^String v]
(cond
- (or (u/matches-regex u/unsigned-long-re v)
- (u/matches-regex u/unsigned-int-re v)) (parse-unsigned-const v)
- (or (u/matches-regex u/signed-long-re v)
- (u/matches-regex u/signed-int-re v)) (parse-signed-const v)
+ (u/matches-regex u/floating-point-constant-without-wordbreak v) (parse-double-num v)
+ (or (u/matches-regex u/unsigned-long-re-without-wordbreak v)
+ (u/matches-regex u/unsigned-int-re-without-wordbreak v)) (parse-unsigned-const v)
+ (or (u/matches-regex u/signed-long-re-without-wordbreak v)
+ (u/matches-regex u/signed-int-re-without-wordbreak v)) (parse-signed-const v)
:else (exc/parser-error "Invalid constant." {:constant v})))
(defn- parse-factor [[{kind :kind :as token} :as tokens]]
@@ -488,7 +490,7 @@
:else (throw (ex-info "Parser error. Not able to parse variable declaration." {})))))
(defn- parse-type-and-storage-class [specifiers]
- (let [valid-types #{:int :long :signed :unsigned}
+ (let [valid-types #{:int :long :signed :unsigned :double}
{types true, storage-classes false} (group-by #(contains? valid-types (:specifier-type %)) specifiers)
type-specifier (parse-type types)
storage-class (if (> (count storage-classes) 1)
@@ -519,8 +521,7 @@
(defn- parse-program [tokens]
(let [[declarations tokens] (parse-repeatedly tokens parse-declaration :eof)
_ (expect :eof tokens)
- ;_ (m/coerce #'s/Program declarations)
- ]
+ _ (m/coerce #'s/Program declarations)]
declarations))
(defn parse [tokens]
diff --git a/src/cljcc/schema.clj b/src/cljcc/schema.clj
index 663604c..8b5d3a8 100644
--- a/src/cljcc/schema.clj
+++ b/src/cljcc/schema.clj
@@ -48,7 +48,7 @@
(def Const
[:map
- [:type [:enum :int :long :uint :ulong]]
+ [:type [:enum :int :long :uint :ulong :double]]
[:value number?]])
(def ConstantExp
diff --git a/src/cljcc/util.clj b/src/cljcc/util.clj
index 7f59407..351b11f 100644
--- a/src/cljcc/util.clj
+++ b/src/cljcc/util.clj
@@ -87,19 +87,32 @@
(defn matches-regex [re s]
(not (nil? (re-matches re s))))
+(def unsigned-long-re-without-wordbreak #"[0-9]+([lL][uU]|[uU][lL])")
+(def signed-long-re-without-wordbreak #"[0-9]+[lL]")
+(def unsigned-int-re-without-wordbreak #"[0-9]+[uU]")
+(def signed-int-re-without-wordbreak #"[0-9]+")
+(def floating-point-constant-without-wordbreak #"([0-9]*\.[0-9]+|[0-9]+\.?)[Ee][+-]?[0-9]+|[0-9]*\.[0-9]+|[0-9]+\.")
+
(def unsigned-long-re #"([0-9]+([lL][uU]|[uU][lL]))[^\w.]")
(def signed-long-re #"([0-9]+[lL])[^\w.]")
(def unsigned-int-re #"([0-9]+[uU])[^\w.]")
(def signed-int-re #"([0-9]+)[^\w.]")
(def floating-point-constant #"(([0-9]*\.[0-9]+|[0-9]+\.?)[Ee][+-]?[0-9]+|[0-9]*\.[0-9]+|[0-9]+\.)[^\w.]")
+(defn- re-find-indexed [re s]
+ (let [matcher (re-matcher re s)]
+ (when (.find matcher)
+ [(.group matcher 1)
+ (.start matcher 1)
+ (.end matcher 1)])))
+
(defn match-regex
"Returns matched string and remaining string tuple, otherwise returns nil.
The first match by re-finds must be the starting subsequence, otherwise false."
[re s]
- (when-let [matched (second (re-find re s))]
- (when (str/starts-with? s matched)
+ (when-let [[matched start-index _] (re-find-indexed re s)]
+ (when (and (= 0 start-index) (str/starts-with? s matched))
[matched (str/replace-first s matched "")])))
(defn read-number