Fix lexer bug, pass parsing stage

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