aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/cljcc/analyze/core.clj1
-rw-r--r--src/cljcc/analyze/label_loops.clj104
-rw-r--r--src/cljcc/analyze/resolve.clj299
-rw-r--r--src/cljcc/analyze/typecheck.clj236
-rw-r--r--src/cljcc/analyzer.clj2
-rw-r--r--src/cljcc/parser.clj77
-rw-r--r--src/cljcc/token.clj14
7 files changed, 675 insertions, 58 deletions
diff --git a/src/cljcc/analyze/core.clj b/src/cljcc/analyze/core.clj
new file mode 100644
index 0000000..84fe818
--- /dev/null
+++ b/src/cljcc/analyze/core.clj
@@ -0,0 +1 @@
+(ns cljcc.analyze.core)
diff --git a/src/cljcc/analyze/label_loops.clj b/src/cljcc/analyze/label_loops.clj
new file mode 100644
index 0000000..94cefc2
--- /dev/null
+++ b/src/cljcc/analyze/label_loops.clj
@@ -0,0 +1,104 @@
+(ns cljcc.analyze.label-loops
+ (:require [cljcc.parser :as p]
+ [cljcc.exception :as exc]
+ [cljcc.analyze.resolve :as r]
+ [cljcc.util :as util]
+ [malli.dev.pretty :as pretty]))
+
+(defn- unique-identifier [identifier]
+ (util/create-identifier! identifier))
+
+(defn- annotate-label [m label]
+ (assoc m :label label))
+
+(defn- label-statement
+ ([s]
+ (label-statement s nil))
+ ([{:keys [statement-type] :as s} current-label]
+ (condp = statement-type
+ :break (if (nil? current-label)
+ (exc/analyzer-error "break statement outside of loop" s)
+ (p/break-statement-node current-label))
+ :continue (if (nil? current-label)
+ (exc/analyzer-error "continue statement outside of loop" s)
+ (p/continue-statement-node current-label))
+ :while (let [new-label (unique-identifier "while_label")
+ l-body (label-statement (:body s) new-label)
+ l-while (p/while-statement-node (:condition s) l-body)]
+ (annotate-label l-while new-label))
+ :do-while (let [new-label (unique-identifier "do_while_label")
+ l-body (label-statement (:body s) new-label)
+ l-do-while (p/do-while-statement-node (:condition s) l-body)]
+ (annotate-label l-do-while new-label))
+ :for (let [new-label (unique-identifier "for_label")
+ l-body (label-statement (:body s) new-label)
+ l-for (p/for-statement-node (:init s) (:condition s) (:post s) l-body)]
+ (annotate-label l-for new-label))
+ :if (if (:else-statement s)
+ (p/if-statement-node (:condition s)
+ (label-statement (:then-statement s) current-label)
+ (label-statement (:else-statement s) current-label))
+ (p/if-statement-node (:condition s)
+ (label-statement (:then-statement s) current-label)))
+ :compound (let [update-block-f (fn [item]
+ (if (= (:type item) :statement)
+ (label-statement item current-label)
+ item))
+ new-block (mapv update-block-f (:block s))]
+ (p/compound-statement-node new-block))
+ :return s
+ :expression s
+ :empty s
+ (exc/analyzer-error "invalid statement reached during loop labelling." s))))
+
+(defn- label-loop-function-body [fn-declaration]
+ (let [statement? (fn [x] (= :statement (:type x)))
+ labelled-body (mapv (fn [block-item]
+ (if (statement? block-item)
+ (label-statement block-item)
+ block-item))
+ (:body fn-declaration))]
+ (assoc fn-declaration :body labelled-body)))
+
+(defn label-loops
+ "Annotates labels on looping constructs.
+
+ Parameter:
+ program: List of declarations / blocks"
+ [program]
+ (let [fn-declaration? (fn [x] (= :function (:declaration-type x)))]
+ (mapv (fn [block]
+ (if (fn-declaration? block)
+ (label-loop-function-body block)
+ block))
+ program)))
+
+(comment
+
+ (-> "./test-programs/example.c"
+ slurp
+ p/parse-from-src
+ r/resolve-program)
+
+ (-> "./test-programs/example.c"
+ slurp
+ p/parse-from-src
+ r/resolve-program
+ label-loops)
+
+ (pretty/explain
+ p/Program
+ (-> "./test-programs/example.c"
+ slurp
+ p/parse-from-src
+ r/resolve-program))
+
+ (pretty/explain
+ p/Program
+ (-> "./test-programs/example.c"
+ slurp
+ p/parse-from-src
+ r/resolve-program
+ label-loops))
+
+ ())
diff --git a/src/cljcc/analyze/resolve.clj b/src/cljcc/analyze/resolve.clj
new file mode 100644
index 0000000..b633405
--- /dev/null
+++ b/src/cljcc/analyze/resolve.clj
@@ -0,0 +1,299 @@
+(ns cljcc.analyze.resolve
+ (:require [cljcc.exception :as exc]
+ [cljcc.parser :as p]
+ [malli.dev.pretty :as pretty]
+ [cljcc.util :as util]
+ [malli.core :as m]))
+
+(defn- unique-identifier [identifier]
+ (util/create-identifier! identifier))
+
+(defn- copy-identifier-map
+ "Returns a copy of the identifier -> symbol map.
+
+ Sets :at-top-level false, as it's going inside a scope. ( Could be fn definition, compound statement ).
+ Sets :from-current-scope as false for every symbol. Used when going into a inner scope."
+ [ident->symbol]
+ (let [set-from-current-scope-as-false (fn [i->s]
+ (zipmap (keys i->s)
+ (map (fn [s]
+ (assoc s :from-current-scope false))
+ (vals i->s))))]
+ (-> ident->symbol
+ (dissoc :at-top-level)
+ set-from-current-scope-as-false
+ (assoc :at-top-level false))))
+
+(declare resolve-block resolve-declaration resolve-optional-exp)
+
+(defn- resolve-exp [e ident->symbol]
+ (condp = (:exp-type e)
+ :constant-exp e
+ :variable-exp (if (contains? ident->symbol (:identifier e))
+ (p/variable-exp-node (:name (get ident->symbol (:identifier e))))
+ (exc/analyzer-error "Undeclared variable seen." {:variable e}))
+ :assignment-exp (let [left (:left e)
+ right (:right e)
+ op (:assignment-operator e)
+ left-var? (= :variable-exp (:exp-type left))]
+ (if left-var?
+ (p/assignment-exp-node (resolve-exp left ident->symbol)
+ (resolve-exp right ident->symbol)
+ op)
+ (exc/analyzer-error "Invalid lvalue in assignment expression." {:lvalue e})))
+ :binary-exp (p/binary-exp-node (resolve-exp (:left e) ident->symbol)
+ (resolve-exp (:right e) ident->symbol)
+ (:binary-operator e))
+ :unary-exp (p/unary-exp-node (:unary-operator e) (resolve-exp (:value e) ident->symbol))
+ :conditional-exp (p/conditional-exp-node (resolve-exp (:left e) ident->symbol)
+ (resolve-exp (:middle e) ident->symbol)
+ (resolve-exp (:right e) ident->symbol))
+ :cast-exp (p/cast-exp-node (:target-type e)
+ (resolve-exp (:value e) ident->symbol))
+ :function-call-exp (let [fn-name (:identifier e)
+ args (:arguments e)]
+ (if (contains? ident->symbol fn-name)
+ (p/function-call-exp-node (:new-name (get ident->symbol fn-name))
+ (mapv #(resolve-exp % ident->symbol) args))
+ (throw (ex-info "Undeclared function !" {:function-name fn-name}))))
+ (exc/analyzer-error "Invalid expression." {:exp e})))
+
+(defn- resolve-optional-exp [e ident->symbol]
+ (if (nil? e)
+ e
+ (resolve-exp e ident->symbol)))
+
+(defn- resolve-file-scope-variable-declaration
+ "Adds file scope variable declaration to scope.
+
+ Directly adds variable declaration to map as it is top level."
+ [{:keys [identifier] :as declaration} ident->symbol]
+ {:declaration declaration
+ :ident->symbol (assoc ident->symbol identifier {:new-name identifier
+ :name identifier
+ :from-current-scope true
+ :has-linkage true})})
+
+(defn- resolve-local-variable-declaration
+ "Add local variable declaration.
+
+ Validates for variables declared with same name.
+ Validates for variables declared from different scope, but with conflicting storage class."
+ [{:keys [identifier initial variable-type storage-class] :as declaration} ident->symbol]
+ (let [prev-entry (get ident->symbol identifier)
+ extern? (= storage-class :extern)
+ _ (when (and prev-entry (:from-current-scope prev-entry))
+ (when (not (and (:has-linkage prev-entry) extern?))
+ (exc/analyzer-error "Conflicting local declaration." {:declaration declaration})))]
+ (if extern?
+ {:declaration declaration
+ :ident->symbol (assoc ident->symbol identifier {:new-name identifier
+ :name identifier
+ :from-current-scope true
+ :has-linkage true})}
+ (let [unique-name (unique-identifier identifier)
+ updated-symbols (assoc ident->symbol identifier {:new-name unique-name
+ :name unique-name
+ :from-current-scope true
+ :has-linkage false})
+ init-value (when initial (resolve-exp initial updated-symbols))]
+ {:declaration (p/variable-declaration-node unique-name storage-class variable-type init-value)
+ :ident->symbol updated-symbols}))))
+
+(defn- resolve-variable-declaration
+ "Resolves variable declarations.
+
+ Ensures variable not declared twice in the current scope."
+ [decl {:keys [at-top-level] :as ident->symbol}]
+ (if at-top-level
+ (resolve-file-scope-variable-declaration decl ident->symbol)
+ (resolve-local-variable-declaration decl ident->symbol)))
+
+(defn- resolve-parameter [parameter ident->symbol]
+ (if (and (contains? ident->symbol parameter)
+ (:from-current-scope (get ident->symbol parameter)))
+ (exc/analyzer-error "Parameter name duplicated." {:parameter parameter})
+ (let [unique-name (unique-identifier parameter)
+ updated-identifier-map (assoc ident->symbol parameter {:name unique-name
+ :from-current-scope true
+ :has-linkage false})]
+ {:parameter unique-name
+ :ident->symbol updated-identifier-map})))
+
+(defn- resolve-parameters [params ident->symbol]
+ (reduce (fn [acc p]
+ (let [{:keys [parameter ident->symbol]} (resolve-parameter p (:ident->symbol acc))]
+ {:parameters (conj (:parameters acc) parameter)
+ :ident->symbol ident->symbol}))
+ {:parameters [] :ident->symbol ident->symbol}
+ params))
+
+(defn- resolve-function-declaration
+ "Resolve function declaration.
+
+ Ensures functions not declared twice in current scope with incorrect linkage."
+ [{:keys [identifier storage-class parameters function-type body] :as d} ident->symbol]
+ (let [prev-entry (get ident->symbol identifier)
+ already-declared-var? (and (contains? ident->symbol identifier)
+ (:from-current-scope (get ident->symbol identifier))
+ (not (:has-linkage prev-entry)))
+ illegally-redeclared? (and (contains? ident->symbol identifier)
+ (:from-current-scope prev-entry)
+ (not (:has-linkage prev-entry)))
+ static? (= :static storage-class)
+ inside-function-definition? (not (:at-top-level ident->symbol))
+ _ (when already-declared-var?
+ (exc/analyzer-error "Variable already declared in same scope." {:declaration d}))
+ _ (when illegally-redeclared?
+ (exc/analyzer-error "Function duplicate declaration." {:declaration d}))
+ updated-identifier-map (assoc ident->symbol identifier {:new-name identifier
+ :name identifier
+ :from-current-scope true
+ :has-linkage true})
+ inner-map (copy-identifier-map updated-identifier-map)
+ {new-params :parameters, inner-map :ident->symbol} (resolve-parameters parameters inner-map)
+ _ (when (and body inside-function-definition?)
+ (exc/analyzer-error "Nested function definition not allowed." {:declaration d
+ :ident->symbol ident->symbol}))
+ _ (when (and inside-function-definition? static?)
+ (exc/analyzer-error "Nested static function declarations cannot exist." {:declaration d}))
+ new-body (when body (resolve-block body inner-map))]
+ {:declaration (p/function-declaration-node function-type storage-class identifier new-params (:block new-body))
+ :ident->symbol updated-identifier-map}))
+
+(defn- resolve-declaration [{:keys [declaration-type] :as d} ident->symbol]
+ (condp = declaration-type
+ :variable (resolve-variable-declaration d ident->symbol)
+ :function (resolve-function-declaration d ident->symbol)
+ (throw (ex-info "Analyzer Error. Invalid declaration type." {:declaration d}))))
+
+(defn- resolve-for-init [for-init ident->symbol]
+ (if (= (:type for-init) :declaration)
+ (resolve-declaration for-init ident->symbol)
+ (resolve-optional-exp for-init ident->symbol)))
+
+(defmulti resolve-statement
+ "Resolves statements in a given scope.
+
+ Scope here refers to the ident->symbol map, which holds declarations
+ visisble to statement at this time.
+
+ Dispatches based on the type of statement.
+
+ Returns statement after recursively resolving all expressions and statements.
+ "
+ (fn [statement _ident->symbol]
+ (:statement-type statement)))
+
+(defmethod resolve-statement :default [statement _]
+ (exc/analyzer-error "Invalid statement." {:statement statement}))
+
+(defmethod resolve-statement :return [{:keys [value]} ident->symbol]
+ (p/return-statement-node (resolve-exp value ident->symbol)))
+
+(defmethod resolve-statement :break [statement _]
+ statement)
+
+(defmethod resolve-statement :continue [statement _]
+ statement)
+
+(defmethod resolve-statement :empty [statement _]
+ statement)
+
+(defmethod resolve-statement :expression [{:keys [value]} ident->symbol]
+ (p/expression-statement-node (resolve-exp value ident->symbol)))
+
+(defmethod resolve-statement :if [{:keys [condition then-statement else-statement]} ident->symbol]
+ (if else-statement
+ (p/if-statement-node (resolve-exp condition ident->symbol)
+ (resolve-statement then-statement ident->symbol)
+ (resolve-statement else-statement ident->symbol))
+ (p/if-statement-node (resolve-exp condition ident->symbol)
+ (resolve-statement then-statement ident->symbol))))
+
+(defmethod resolve-statement :while [{:keys [condition body]} ident->symbol]
+ (p/while-statement-node (resolve-exp condition ident->symbol)
+ (resolve-statement body ident->symbol)))
+
+(defmethod resolve-statement :do-while [{:keys [condition body]} ident->symbol]
+ (p/do-while-statement-node (resolve-exp condition ident->symbol)
+ (resolve-statement body ident->symbol)))
+
+(defmethod resolve-statement :for [{:keys [init condition post body]} ident->symbol]
+ (let [for-scope-identifier-map (copy-identifier-map ident->symbol)
+ resolved-for-init (resolve-for-init init for-scope-identifier-map)
+ for-scope-identifier-map (if (:declaration resolved-for-init) ; updates symbol map if for initializer is declaration
+ (:ident->symbol resolved-for-init)
+ for-scope-identifier-map)
+ resolved-for-init (if (:declaration resolved-for-init) ; getting the underlying declaration, if it is
+ (:declaration resolved-for-init)
+ resolved-for-init)
+ condition (resolve-optional-exp condition for-scope-identifier-map)
+ post (resolve-optional-exp post for-scope-identifier-map)
+ body (resolve-statement body for-scope-identifier-map)]
+ (p/for-statement-node resolved-for-init condition post body)))
+
+(defmethod resolve-statement :compound [{:keys [block]} ident->symbol]
+ (p/compound-statement-node (:block (resolve-block block (copy-identifier-map ident->symbol)))))
+
+(defn- resolve-block-item [{:keys [type] :as item} ident->symbol]
+ (condp = type
+ :declaration (let [{d :declaration
+ i->s :ident->symbol} (resolve-declaration item ident->symbol)]
+ {:block-item d
+ :ident->symbol i->s})
+ :statement {:block-item (resolve-statement item ident->symbol)
+ :ident->symbol ident->symbol}))
+
+(defn- resolve-block
+ "Resolves a block under a given symbol table.
+
+ Block is list of block items.
+
+ ident->symbol holds identifier to symbol mapping.
+ Symbol contains the type information, generated variable name etc.
+
+ | key | description |
+ |----------------|-------------|
+ |`:at-top-level` | Is current level top or not ( default true)|"
+ ([block]
+ (resolve-block block {:at-top-level true}))
+ ([block ident->symbol]
+ (let [reduce-f (fn [acc block-item]
+ (let [res (resolve-block-item block-item (:ident->symbol acc))]
+ {:block (conj (:block acc) (:block-item res))
+ :ident->symbol (:ident->symbol res)}))]
+ (reduce reduce-f
+ {:block []
+ :ident->symbol ident->symbol}
+ block))))
+
+;; Program is list of block items, which are themselves just blocks.
+(defn resolve-program [program]
+ (let [res (:block (resolve-block program))
+ _ (m/coerce p/Program res)]
+ res))
+
+(comment
+
+ (def file-path "./test-programs/example.c")
+
+ (slurp "./test-programs/example.c")
+
+ (-> file-path
+ slurp
+ p/parse-from-src)
+
+ (-> file-path
+ slurp
+ p/parse-from-src
+ resolve-program)
+
+ (pretty/explain
+ p/Program
+ (-> file-path
+ slurp
+ p/parse-from-src
+ resolve-program))
+
+ ())
diff --git a/src/cljcc/analyze/typecheck.clj b/src/cljcc/analyze/typecheck.clj
new file mode 100644
index 0000000..f2671dc
--- /dev/null
+++ b/src/cljcc/analyze/typecheck.clj
@@ -0,0 +1,236 @@
+(ns cljcc.analyze.typecheck
+ (:require [malli.core :as m]
+ [malli.dev.pretty :as pretty]
+ [cljcc.parser :as p]
+ [cljcc.token :as t]
+ [cljcc.exception :as exc]))
+
+(declare typecheck-block typecheck-declaration)
+
+(def FunAttribute
+ [:map
+ [:type [:= :fun]]
+ [:defined? boolean?]
+ [:global? boolean?]])
+
+(def LocalAttribute
+ [:map
+ [:type [:= :local]]])
+
+(def StaticAttribute
+ [:map
+ [:type [:= :static]]
+ [:global? boolean?]])
+
+(def Attribute
+ [:multi {:dispatch :type}
+ [:fun #'FunAttribute]
+ [:static #'StaticAttribute]
+ [:local #'LocalAttribute]])
+
+(def Symbol
+ [:map
+ [:type #'p/Type]
+ [:attribute #'Attribute]])
+
+(defn- set-type
+ "Assocs onto an expression given type."
+ [e t] (assoc e :value-type t))
+
+(defn- get-type [e] (:value-type e))
+
+(defn- symbol-function? [s]
+ (= :function (:type (:type s))))
+
+(defmulti typecheck-exp
+ "Returns the expression, after typechecking nested expressions."
+ (fn [{:keys [exp-type]} _ident->symbol] exp-type))
+
+(defmethod typecheck-exp :constant-exp
+ [{:keys [value] :as e} _]
+ (condp = (:type value)
+ :int (set-type e {:type :int})
+ :long (set-type e {:type :long})))
+
+(defmethod typecheck-exp :variable-exp
+ [{:keys [identifier] :as e} ident->symbol]
+ (let [s (get ident->symbol identifier)]
+ (if (symbol-function? s)
+ (exc/analyzer-error "Function name used as variable." {:expression e})
+ (set-type e (:type s)))))
+
+(defmethod typecheck-exp :cast-exp
+ [{:keys [target-type value]} ident->symbol]
+ (let [typed-inner-e (typecheck-exp value ident->symbol)
+ cast-exp (p/cast-exp-node target-type typed-inner-e)]
+ (set-type cast-exp target-type)))
+
+(defmethod typecheck-exp :unary-exp
+ [{:keys [unary-operator value]} ident->symbol]
+ (let [typed-inner-e (typecheck-exp value ident->symbol)
+ unary-exp (p/unary-exp-node unary-operator typed-inner-e)]
+ (condp = unary-operator
+ :logical-not (set-type unary-exp {:type :int})
+ (set-type unary-exp (get-type typed-inner-e)))))
+
+(defn- get-common-type [t1 t2]
+ (if (= t1 t2)
+ t1
+ {:type :long}))
+
+(defn- convert-to-exp
+ "Returns expression, using casting if necessary."
+ [e t]
+ (if (= (get-type e) t)
+ e
+ (set-type (p/cast-exp-node t e) t)))
+
+(defmethod typecheck-exp :binary-exp
+ [{: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)]
+ (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]
+ (let
+ [typed-left (typecheck-exp left ident->symbol)
+ typed-right (typecheck-exp right ident->symbol)
+ 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)))
+
+(defmethod typecheck-exp :function-call-exp
+ [{: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}))))
+
+(defmulti typecheck-statement
+ "Dispatches based on type of statement.
+
+ Parameters:
+ - return-type: Return type of statement's enclosing function.
+ - statement
+ - ident->symbol: Symbol map for current scope."
+ (fn [_return-type {:keys [statement-type]} _ident->symbol]
+ statement-type))
+
+(defmethod typecheck-statement :return
+ [return-type {:keys [value]} ident->symbol]
+ {:statement (p/return-statement-node
+ (convert-to-exp (typecheck-exp value ident->symbol)
+ return-type))
+ :ident->symbol ident->symbol})
+
+(defmethod typecheck-statement :expression
+ [_ {:keys [value]} ident->symbol]
+ {:statement (p/expression-statement-node (typecheck-exp value ident->symbol))
+ :ident->symbol ident->symbol})
+
+(defmethod typecheck-statement :break
+ [_ s m]
+ {:statement s
+ :ident->symbol m})
+
+(defmethod typecheck-statement :continue
+ [_ s m]
+ {:statement s
+ :ident->symbol m})
+
+(defmethod typecheck-statement :empty
+ [_ s m]
+ {:statement s
+ :ident->symbol m})
+
+(defmethod typecheck-statement :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/while-statement-node typed-cond 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))
+ :ident->symbol (:ident->symbol typed-body)}))
+
+(defn- typecheck-optional-expression [e m]
+ (if (nil? e)
+ e
+ (typecheck-exp e m)))
+
+(defn- typecheck-for-init [for-init ident->symbol]
+ (if (= (:type for-init) :declaration)
+ (typecheck-declaration for-init ident->symbol)
+ (typecheck-optional-expression for-init ident->symbol)))
+
+(defmethod typecheck-statement :for
+ [return-type {:keys [init post condition body] :as stmt} m]
+ (let [f-init (typecheck-for-init init m)
+ m' (if (:declaration f-init)
+ (:ident->symbol f-init)
+ m)
+ t-condition (typecheck-optional-expression condition m')
+ t-post (typecheck-optional-expression post m')
+ typed-body-statement (typecheck-statement return-type body m')]
+ {:statement (merge stmt
+ (p/for-statement-node f-init t-condition t-post (:statement typed-body-statement)))
+ :ident->symbol (:ident->symbol typed-body-statement)}))
+
+(defmethod typecheck-statement :if
+ [return-type {:keys [condition then-statement else-statement]} m])
+
+(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)
+ :ident->symbol (:ident->symbol typed-block)}))
+
+(defn- typecheck-block [return-type block ident->symbol])
+
+(defn- typecheck-declaration [])
+
+(defn- typecheck-program [program]
+ ())
+
+(defn typecheck
+ "Typechecks given program.
+
+ Program := [Block]"
+ [program])
+
+(comment
+
+ ())
diff --git a/src/cljcc/analyzer.clj b/src/cljcc/analyzer.clj
index 0d8a763..fbdc131 100644
--- a/src/cljcc/analyzer.clj
+++ b/src/cljcc/analyzer.clj
@@ -48,6 +48,8 @@
:conditional-exp (p/conditional-exp-node (resolve-exp (:left e) ident->symbol)
(resolve-exp (:middle e) ident->symbol)
(resolve-exp (:right e) ident->symbol))
+ :cast-exp (p/cast-exp-node (:target-type e)
+ (resolve-exp (:value e)))
:function-call-exp (let [fn-name (:identifier e)
args (:arguments e)]
(if (contains? ident->symbol fn-name)
diff --git a/src/cljcc/parser.clj b/src/cljcc/parser.clj
index f8e9134..c11d6b5 100644
--- a/src/cljcc/parser.clj
+++ b/src/cljcc/parser.clj
@@ -44,27 +44,31 @@
[:map
[:type [:= :exp]]
[:exp-type [:= :constant-exp]]
- [:value #'Const]])
+ [:value #'Const]
+ [:value-type {:optional true} #'Type]])
(def VariableExp
[:map
[:type [:= :exp]]
[:exp-type [:= :variable-exp]]
- [:identifier string?]])
+ [:identifier string?]
+ [:value-type {:optional true} #'Type]])
(def CastExp
[:map
[:type [:= :exp]]
[:exp-type [:= :cast-exp]]
[:target-type #'Type]
- [:value [:ref #'Exp]]])
+ [:value [:ref #'Exp]]
+ [:value-type {:optional true} #'Type]])
(def UnaryExp
[:map
[:type [:= :exp]]
[:exp-type [:= :unary-exp]]
[:unary-operator `[:enum ~@t/unary-ops]]
- [:value [:ref #'Exp]]])
+ [:value [:ref #'Exp]]
+ [:value-type {:optional true} #'Type]])
(def BinaryExp
[:map
@@ -72,7 +76,8 @@
[:exp-type [:= :binary-exp]]
[:binary-operator `[:enum ~@(set (keys t/bin-ops))]]
[:left [:ref #'Exp]]
- [:right [:ref #'Exp]]])
+ [:right [:ref #'Exp]]
+ [:value-type {:optional true} #'Type]])
(def AssignmentExp
[:map
@@ -80,7 +85,8 @@
[:exp-type [:= :assignment-exp]]
[:assignment-operator `[:enum ~@t/assignment-ops]]
[:left [:ref #'Exp]]
- [:right [:ref #'Exp]]])
+ [:right [:ref #'Exp]]
+ [:value-type {:optional true} #'Type]])
(def ConditionalExp
[:map
@@ -88,14 +94,16 @@
[:exp-type [:= :conditional-exp]]
[:left [:ref #'Exp]]
[:middle [:ref #'Exp]]
- [:right [:ref #'Exp]]])
+ [:right [:ref #'Exp]]
+ [:value-type {:optional true} #'Type]])
(def FunctionCallExp
[:map
[:type [:= :exp]]
[:exp-type [:= :function-call-exp]]
[:identifier string?]
- [:arguments [:vector [:ref #'Exp]]]])
+ [:arguments [:vector [:ref #'Exp]]]
+ [:value-type {:optional true} #'Type]])
(def Exp
[:schema {:registry {::mexp-constant #'ConstantExp
@@ -170,6 +178,7 @@
[:type [:= :statement]]
[:statement-type [:= :while]]
[:condition #'Exp]
+ [:label {:optional true} string?]
[:body [:ref #'Statement]]])
(def DoWhileStatement
@@ -177,6 +186,7 @@
[:type [:= :statement]]
[:statement-type [:= :do-while]]
[:condition #'Exp]
+ [:label {:optional true} string?]
[:body [:ref #'Statement]]])
(def ForStatement
@@ -188,6 +198,7 @@
[:maybe #'Exp]]]
[:post [:maybe #'Exp]]
[:condition [:maybe #'Exp]]
+ [:label {:optional true} string?]
[:body [:ref #'Statement]]])
(def IfStatement
@@ -740,60 +751,10 @@
(comment
(m/validate
- Program)
-
- (m/coerce
Program
(parse-from-src
"int main(void) {
return (long) 42;
}"))
-
- (pretty/explain
- Program
- (parse-from-src
- "
-long add(int a, int b) {
- return (long) a + (long) b;
-}
-
-int main(void) {
- long a = add(2147483645, 2147483645);
- if (a == 4294967290l) {
- return 1;
- }
- return 0;
-}
-"))
-
- (pretty/explain
- Program
- (parse-from-src
- "int main(void) {
- long l = 9223372036854775807l;
- return (l - 2l == 9223372036854775805l);
-}
-"))
-
-
- (parse-from-src "
-int main(void) {
-
- int x = 0;
-
- for (int i = 0; i < 10; i = i + 1) {
- x = x + 1;
- }
-
- return x;
-}
-
-int foo(int x) {
-x += 1;
-return x;
-}
-
-")
-
())
diff --git a/src/cljcc/token.clj b/src/cljcc/token.clj
index 60f66ee..86231b8 100644
--- a/src/cljcc/token.clj
+++ b/src/cljcc/token.clj
@@ -126,6 +126,20 @@
(defn binary-op? [op]
(contains? bin-ops op))
+(defn logical? [v]
+ (contains? #{:logical-and
+ :logical-not
+ :logical-or} v))
+
+(defn arithmetic? [v]
+ (contains?
+ #{:multiply
+ :divide
+ :remainder
+ :plus
+ :hyphen}
+ v))
+
(defn precedence [op]
(op bin-ops))