diff options
| -rw-r--r-- | src/cljcc/analyze/resolve.clj | 7 | ||||
| -rw-r--r-- | src/cljcc/analyze/typecheck.clj | 71 | ||||
| -rw-r--r-- | src/cljcc/exception.clj | 3 | ||||
| -rw-r--r-- | src/cljcc/parser.clj | 270 | ||||
| -rw-r--r-- | src/cljcc/schema.clj | 318 | ||||
| -rw-r--r-- | src/cljcc/tacky.clj | 6 |
6 files changed, 335 insertions, 340 deletions
diff --git a/src/cljcc/analyze/resolve.clj b/src/cljcc/analyze/resolve.clj index b633405..9250e49 100644 --- a/src/cljcc/analyze/resolve.clj +++ b/src/cljcc/analyze/resolve.clj @@ -2,6 +2,7 @@ (:require [cljcc.exception :as exc] [cljcc.parser :as p] [malli.dev.pretty :as pretty] + [cljcc.schema :as s] [cljcc.util :as util] [malli.core :as m])) @@ -271,8 +272,8 @@ ;; 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)) + _ (m/coerce s/Program res)] + res)) (comment @@ -290,7 +291,7 @@ resolve-program) (pretty/explain - p/Program + s/Program (-> file-path slurp p/parse-from-src diff --git a/src/cljcc/analyze/typecheck.clj b/src/cljcc/analyze/typecheck.clj index 001c618..7f8134a 100644 --- a/src/cljcc/analyze/typecheck.clj +++ b/src/cljcc/analyze/typecheck.clj @@ -3,76 +3,13 @@ [malli.dev.pretty :as pretty] [cljcc.parser :as p] [cljcc.token :as t] + [cljcc.schema :as s] [cljcc.analyze.resolve :as r] [cljcc.analyze.label-loops :as l] [cljcc.exception :as exc])) (declare typecheck-block typecheck-declaration to-static-init) -(def FunAttribute - [:map - [:type [:= :fun]] - [:defined? boolean?] - [:global? boolean?]]) - -(def LocalAttribute - [:map - [:type [:= :local]]]) - -(def NoInitializer - [:map - [:type [:= :no-initializer]]]) - -(def Tentative - [:map - [:type [:= :tentative]]]) - -(def IntInit - [:map - [:type [:= :int-init]] - [:value int?]]) - -(def LongInit - [:map - [:type [:= :long-init]] - [:value int?]]) - -(def Initial - [:map - [:type [:= :initial]] - [:static-init [:or IntInit LongInit]]]) - -(def InitialValue - [:or - NoInitializer - Tentative - Initial]) - -(def StaticAttribute - [:map - [:type [:= :static]] - [:global? boolean?] - [:initial-value #'InitialValue]]) - -(def Attribute - [:multi {:dispatch :type} - [:fun #'FunAttribute] - [:static #'StaticAttribute] - [:local #'LocalAttribute]]) - -(def Symbol - [:map - [:type #'p/Type] - [:attribute #'Attribute]]) - -(def SymbolMap - [:map-of string? #'Symbol]) - -(def TypecheckedOut - [:map - [:ident->symbol #'SymbolMap] - [:program p/Program]]) - (defn- create-symbol [type attribute] {:type type :attribute attribute}) @@ -535,8 +472,8 @@ (let [v (typecheck-program program) program (:program v) m (dissoc (:ident->symbol v) :at-top-level) - _ (m/coerce p/Program program) - _ (m/coerce SymbolMap m)] + _ (m/coerce s/Program program) + _ (m/coerce s/SymbolMap m)] {:program program :ident->symbol m})) @@ -558,7 +495,7 @@ typecheck) (pretty/explain - #'TypecheckedOut + s/TypecheckedOut (-> file-path slurp p/parse-from-src diff --git a/src/cljcc/exception.clj b/src/cljcc/exception.clj index bf98ed4..b8b8256 100644 --- a/src/cljcc/exception.clj +++ b/src/cljcc/exception.clj @@ -11,5 +11,8 @@ (defn analyzer-error [msg data] (throw (ex-info msg (merge {:error/type :analyzer} data)))) +(defn tacky-error [msg data] + (throw (ex-info msg (merge {:error/type :tacky} data)))) + (defn compiler-error [msg data] (throw (ex-info msg (merge {:error/type :compiler} data)))) diff --git a/src/cljcc/parser.clj b/src/cljcc/parser.clj index c11d6b5..7e0ca06 100644 --- a/src/cljcc/parser.clj +++ b/src/cljcc/parser.clj @@ -4,276 +4,10 @@ [cljcc.token :as t] [malli.core :as m] [clojure.math :refer [pow]] - [malli.dev.pretty :as pretty] + [cljcc.schema :as s] [cljcc.exception :as exc] [clojure.string :as str])) -(declare Statement Exp Declaration Block Type) - -(def StorageClass [:enum :static :extern]) - -(def IntType - [:map - [:type [:= :int]]]) - -(def LongType - [:map - [:type [:= :long]]]) - -(def FunType - [:map - [:type [:= :function]] - [:return-type [:ref #'Type]] - [:parameter-types [:vector [:ref #'Type]]]]) - -(def Type - [:schema {:registry {::mtype-int #'IntType - ::mtype-long #'LongType - ::mtype-function #'FunType}} - [:multi {:dispatch :type} - [:int #'IntType] - [:long #'LongType] - [:function #'FunType]]]) - -(def Const - [:map - [:type [:enum :int :long]] - [:value int?]]) - -(def ConstantExp - [:map - [:type [:= :exp]] - [:exp-type [:= :constant-exp]] - [:value #'Const] - [:value-type {:optional true} #'Type]]) - -(def VariableExp - [:map - [:type [:= :exp]] - [:exp-type [:= :variable-exp]] - [:identifier string?] - [:value-type {:optional true} #'Type]]) - -(def CastExp - [:map - [:type [:= :exp]] - [:exp-type [:= :cast-exp]] - [:target-type #'Type] - [: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-type {:optional true} #'Type]]) - -(def BinaryExp - [:map - [:type [:= :exp]] - [:exp-type [:= :binary-exp]] - [:binary-operator `[:enum ~@(set (keys t/bin-ops))]] - [:left [:ref #'Exp]] - [:right [:ref #'Exp]] - [:value-type {:optional true} #'Type]]) - -(def AssignmentExp - [:map - [:type [:= :exp]] - [:exp-type [:= :assignment-exp]] - [:assignment-operator `[:enum ~@t/assignment-ops]] - [:left [:ref #'Exp]] - [:right [:ref #'Exp]] - [:value-type {:optional true} #'Type]]) - -(def ConditionalExp - [:map - [:type [:= :exp]] - [:exp-type [:= :conditional-exp]] - [:left [:ref #'Exp]] - [:middle [: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]]] - [:value-type {:optional true} #'Type]]) - -(def Exp - [:schema {:registry {::mexp-constant #'ConstantExp - ::mexp-variable #'VariableExp - ::mexp-cast #'CastExp - ::mexp-unary #'UnaryExp - ::mexp-binary #'BinaryExp - ::mexp-assignment #'AssignmentExp - - ::mexp-conditional #'ConditionalExp - ::mexp-function-call #'FunctionCallExp}} - [:multi {:dispatch :exp-type} - [:constant-exp #'ConstantExp] - [:variable-exp #'VariableExp] - [:cast-exp #'CastExp] - [:unary-exp #'UnaryExp] - [:binary-exp #'BinaryExp] - [:assignment-exp #'AssignmentExp] - [:conditional-exp #'ConditionalExp] - [:function-call-exp #'FunctionCallExp]]]) - -(def VarDeclaration - [:map - [:type [:= :declaration]] - [:declaration-type [:= :variable]] - [:variable-type #'Type] - [:storage-class [:maybe #'StorageClass]] - [:identifier string?] - [:initial [:maybe #'Exp]]]) - -(def FunDeclaration - [:map - [:type [:= :declaration]] - [:declaration-type [:= :function]] - [:function-type #'FunType] - [:identifier string?] - [:storage-class [:maybe #'StorageClass]] - [:parameters [:vector string?]] - [:body [:maybe [:ref #'Block]]]]) - -(def ReturnStatement - [:map - [:type [:= :statement]] - [:statement-type [:= :return]] - [:value #'Exp]]) - -(def ExpressionStatement - [:map - [:type [:= :statement]] - [:statement-type [:= :expression]] - [:value #'Exp]]) - -(def BreakStatement - [:map - [:type [:= :statement]] - [:statement-type [:= :break]] - [:label [:maybe string?]]]) - -(def ContinueStatement - [:map - [:type [:= :statement]] - [:statement-type [:= :continue]] - [:label [:maybe string?]]]) - -(def EmptyStatement - [:map - [:type [:= :statement]] - [:statement-type [:= :empty]]]) - -(def WhileStatement - [:map - [:type [:= :statement]] - [:statement-type [:= :while]] - [:condition #'Exp] - [:label {:optional true} string?] - [:body [:ref #'Statement]]]) - -(def DoWhileStatement - [:map - [:type [:= :statement]] - [:statement-type [:= :do-while]] - [:condition #'Exp] - [:label {:optional true} string?] - [:body [:ref #'Statement]]]) - -(def ForStatement - [:map - [:type [:= :statement]] - [:statement-type [:= :for]] - [:init [:or - [:ref #'VarDeclaration] - [:maybe #'Exp]]] - [:post [:maybe #'Exp]] - [:condition [:maybe #'Exp]] - [:label {:optional true} string?] - [:body [:ref #'Statement]]]) - -(def IfStatement - [:map - [:type [:= :statement]] - [:statement-type [:= :if]] - [:condition #'Exp] - [:then-statement [:ref #'Statement]] - [:else-statement [:maybe [:ref #'Statement]]]]) - -(def CompoundStatement - [:map - [:type [:= :statement]] - [:statement-type [:= :compound]] - [:block [:ref #'Block]]]) - -(def Statement - [:schema {:registry {::mstatement-return #'ReturnStatement - ::mstatement-expression #'ExpressionStatement - ::mstatement-break #'BreakStatement - ::mstatement-continue #'ContinueStatement - ::mstatement-empty #'EmptyStatement - ::mstatement-for #'ForStatement - ::mstatement-while #'WhileStatement - ::mstatement-do-while #'DoWhileStatement - ::mstatement-compound #'CompoundStatement - ::mstatement-if #'IfStatement}} - [:multi {:dispatch :statement-type} - [:return #'ReturnStatement] - [:expression #'ExpressionStatement] - [:break #'BreakStatement] - [:continue #'ContinueStatement] - [:empty #'EmptyStatement] - [:compound #'CompoundStatement] - [:while #'WhileStatement] - [:do-while #'DoWhileStatement] - [:if #'IfStatement] - [:for #'ForStatement]]]) - -(def Declaration - [:schema {:registry {::mdeclaration-function #'FunDeclaration - ::mdeclaration-variable #'VarDeclaration}} - [:multi {:dispatch :declaration-type} - [:function #'FunDeclaration] - [:variable #'VarDeclaration]]]) - -(def BlockItem - [:schema {:registry {::mblockitem-statement #'Statement - ::mblockitem-declaration #'Declaration}} - [:multi {:dispatch :type} - [:statement [:ref #'Statement]] - [:declaration [:ref #'Declaration]]]]) - -(def Block - [:schema {:registry {::mblock-blockitem #'BlockItem}} - [:vector [:ref #'BlockItem]]]) - -(def Program - [:schema {:registry {::mprogram-block #'Block}} - [:vector [:ref #'Declaration]]]) - -(comment - - (pretty/explain - Block - [{:type :statement - :statement-type :compound - :block [{:type :statement - :statement-type :return - :value {:type :exp - :exp-type :variable-exp - :identifier "asd"}}]}]) - - ()) - (declare parse parse-exp parse-statement parse-block expect parse-declaration parse-variable-declaration) (defn- parse-repeatedly @@ -751,7 +485,7 @@ (comment (m/validate - Program + s/Program (parse-from-src "int main(void) { return (long) 42; diff --git a/src/cljcc/schema.clj b/src/cljcc/schema.clj new file mode 100644 index 0000000..9084435 --- /dev/null +++ b/src/cljcc/schema.clj @@ -0,0 +1,318 @@ +(ns cljcc.schema + (:require [cljcc.token :as t])) + +(declare Statement Exp Declaration Block Type) + +(def StorageClass [:enum :static :extern]) + +(def IntType + [:map + [:type [:= :int]]]) + +(def LongType + [:map + [:type [:= :long]]]) + +(def FunType + [:map + [:type [:= :function]] + [:return-type [:ref #'Type]] + [:parameter-types [:vector [:ref #'Type]]]]) + +(def Type + [:schema {:registry {::mtype-int #'IntType + ::mtype-long #'LongType + ::mtype-function #'FunType}} + [:multi {:dispatch :type} + [:int #'IntType] + [:long #'LongType] + [:function #'FunType]]]) + +(def Const + [:map + [:type [:enum :int :long]] + [:value int?]]) + +(def ConstantExp + [:map + [:type [:= :exp]] + [:exp-type [:= :constant-exp]] + [:value #'Const] + [:value-type {:optional true} #'Type]]) + +(def VariableExp + [:map + [:type [:= :exp]] + [:exp-type [:= :variable-exp]] + [:identifier string?] + [:value-type {:optional true} #'Type]]) + +(def CastExp + [:map + [:type [:= :exp]] + [:exp-type [:= :cast-exp]] + [:target-type #'Type] + [: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-type {:optional true} #'Type]]) + +(def BinaryExp + [:map + [:type [:= :exp]] + [:exp-type [:= :binary-exp]] + [:binary-operator `[:enum ~@(set (keys t/bin-ops))]] + [:left [:ref #'Exp]] + [:right [:ref #'Exp]] + [:value-type {:optional true} #'Type]]) + +(def AssignmentExp + [:map + [:type [:= :exp]] + [:exp-type [:= :assignment-exp]] + [:assignment-operator `[:enum ~@t/assignment-ops]] + [:left [:ref #'Exp]] + [:right [:ref #'Exp]] + [:value-type {:optional true} #'Type]]) + +(def ConditionalExp + [:map + [:type [:= :exp]] + [:exp-type [:= :conditional-exp]] + [:left [:ref #'Exp]] + [:middle [: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]]] + [:value-type {:optional true} #'Type]]) + +(def Exp + [:schema {:registry {::mexp-constant #'ConstantExp + ::mexp-variable #'VariableExp + ::mexp-cast #'CastExp + ::mexp-unary #'UnaryExp + ::mexp-binary #'BinaryExp + ::mexp-assignment #'AssignmentExp + + ::mexp-conditional #'ConditionalExp + ::mexp-function-call #'FunctionCallExp}} + [:multi {:dispatch :exp-type} + [:constant-exp #'ConstantExp] + [:variable-exp #'VariableExp] + [:cast-exp #'CastExp] + [:unary-exp #'UnaryExp] + [:binary-exp #'BinaryExp] + [:assignment-exp #'AssignmentExp] + [:conditional-exp #'ConditionalExp] + [:function-call-exp #'FunctionCallExp]]]) + +(def VarDeclaration + [:map + [:type [:= :declaration]] + [:declaration-type [:= :variable]] + [:variable-type #'Type] + [:storage-class [:maybe #'StorageClass]] + [:identifier string?] + [:initial [:maybe #'Exp]]]) + +(def FunDeclaration + [:map + [:type [:= :declaration]] + [:declaration-type [:= :function]] + [:function-type #'FunType] + [:identifier string?] + [:storage-class [:maybe #'StorageClass]] + [:parameters [:vector string?]] + [:body [:maybe [:ref #'Block]]]]) + +(def ReturnStatement + [:map + [:type [:= :statement]] + [:statement-type [:= :return]] + [:value #'Exp]]) + +(def ExpressionStatement + [:map + [:type [:= :statement]] + [:statement-type [:= :expression]] + [:value #'Exp]]) + +(def BreakStatement + [:map + [:type [:= :statement]] + [:statement-type [:= :break]] + [:label [:maybe string?]]]) + +(def ContinueStatement + [:map + [:type [:= :statement]] + [:statement-type [:= :continue]] + [:label [:maybe string?]]]) + +(def EmptyStatement + [:map + [:type [:= :statement]] + [:statement-type [:= :empty]]]) + +(def WhileStatement + [:map + [:type [:= :statement]] + [:statement-type [:= :while]] + [:condition #'Exp] + [:label {:optional true} string?] + [:body [:ref #'Statement]]]) + +(def DoWhileStatement + [:map + [:type [:= :statement]] + [:statement-type [:= :do-while]] + [:condition #'Exp] + [:label {:optional true} string?] + [:body [:ref #'Statement]]]) + +(def ForStatement + [:map + [:type [:= :statement]] + [:statement-type [:= :for]] + [:init [:or + [:ref #'VarDeclaration] + [:maybe #'Exp]]] + [:post [:maybe #'Exp]] + [:condition [:maybe #'Exp]] + [:label {:optional true} string?] + [:body [:ref #'Statement]]]) + +(def IfStatement + [:map + [:type [:= :statement]] + [:statement-type [:= :if]] + [:condition #'Exp] + [:then-statement [:ref #'Statement]] + [:else-statement [:maybe [:ref #'Statement]]]]) + +(def CompoundStatement + [:map + [:type [:= :statement]] + [:statement-type [:= :compound]] + [:block [:ref #'Block]]]) + +(def Statement + [:schema {:registry {::mstatement-return #'ReturnStatement + ::mstatement-expression #'ExpressionStatement + ::mstatement-break #'BreakStatement + ::mstatement-continue #'ContinueStatement + ::mstatement-empty #'EmptyStatement + ::mstatement-for #'ForStatement + ::mstatement-while #'WhileStatement + ::mstatement-do-while #'DoWhileStatement + ::mstatement-compound #'CompoundStatement + ::mstatement-if #'IfStatement}} + [:multi {:dispatch :statement-type} + [:return #'ReturnStatement] + [:expression #'ExpressionStatement] + [:break #'BreakStatement] + [:continue #'ContinueStatement] + [:empty #'EmptyStatement] + [:compound #'CompoundStatement] + [:while #'WhileStatement] + [:do-while #'DoWhileStatement] + [:if #'IfStatement] + [:for #'ForStatement]]]) + +(def Declaration + [:schema {:registry {::mdeclaration-function #'FunDeclaration + ::mdeclaration-variable #'VarDeclaration}} + [:multi {:dispatch :declaration-type} + [:function #'FunDeclaration] + [:variable #'VarDeclaration]]]) + +(def BlockItem + [:schema {:registry {::mblockitem-statement #'Statement + ::mblockitem-declaration #'Declaration}} + [:multi {:dispatch :type} + [:statement [:ref #'Statement]] + [:declaration [:ref #'Declaration]]]]) + +(def Block + [:schema {:registry {::mblock-blockitem #'BlockItem}} + [:vector [:ref #'BlockItem]]]) + +(def Program + [:schema {:registry {::mprogram-block #'Block}} + [:vector [:ref #'Declaration]]]) + +(def FunAttribute + [:map + [:type [:= :fun]] + [:defined? boolean?] + [:global? boolean?]]) + +(def LocalAttribute + [:map + [:type [:= :local]]]) + +(def NoInitializer + [:map + [:type [:= :no-initializer]]]) + +(def Tentative + [:map + [:type [:= :tentative]]]) + +(def IntInit + [:map + [:type [:= :int-init]] + [:value int?]]) + +(def LongInit + [:map + [:type [:= :long-init]] + [:value int?]]) + +(def Initial + [:map + [:type [:= :initial]] + [:static-init [:or IntInit LongInit]]]) + +(def InitialValue + [:or + NoInitializer + Tentative + Initial]) + +(def StaticAttribute + [:map + [:type [:= :static]] + [:global? boolean?] + [:initial-value #'InitialValue]]) + +(def Attribute + [:multi {:dispatch :type} + [:fun #'FunAttribute] + [:static #'StaticAttribute] + [:local #'LocalAttribute]]) + +(def Symbol + [:map + [:type #'Type] + [:attribute #'Attribute]]) + +(def SymbolMap + [:map-of string? #'Symbol]) + +(def TypecheckedOut + [:map + [:ident->symbol #'SymbolMap] + [:program #'Program]]) diff --git a/src/cljcc/tacky.clj b/src/cljcc/tacky.clj index 58026fd..b19dacd 100644 --- a/src/cljcc/tacky.clj +++ b/src/cljcc/tacky.clj @@ -3,6 +3,7 @@ [cljcc.lexer :as l] [cljcc.util :as u] [cljcc.parser :as p] + [cljcc.exception :as exc] [cljcc.analyze.core :as a])) (defn- variable @@ -31,7 +32,7 @@ :complement :bit-not :hyphen :negate :logical-not :logical-not - (throw (ex-info "Tacky Error. Invalid unary operator." {op op})))) + (exc/tacky-error "Invalid unary operator." {op op}))) (defn- assignment-operator->binary-operator "Converts parser assignment operator to binary operator keyword." @@ -384,11 +385,12 @@ :global?])) (assoc :instructions instructions)))) -(defn- tacky-static-variable [identifier global? initial-value] +(defn- tacky-static-variable [identifier global? variable-type initial-value] {:identifier identifier :global? global? :initial-value initial-value :type :declaration + :variable-type variable-type :declaration-type :static-variable}) (defn- tacky-static-variable-instructions [ident->symbols] |