From 4c4c072f576cba040a7cc41b5842166c52d91ff4 Mon Sep 17 00:00:00 2001 From: Vorotynsky Maxim Date: Wed, 17 Nov 2021 10:06:26 +0300 Subject: [PATCH] refactor(ast): split `Kroha.Syntax` into modules --- Kroha.cabal | 10 ++- src/Kroha.hs | 4 +- src/Kroha/Backends/Common.hs | 2 +- src/Kroha/Backends/Nasm.hs | 2 +- src/Kroha/Errors.hs | 2 +- src/Kroha/Instructions.hs | 2 +- src/Kroha/Parser/Declarations.hs | 2 +- src/Kroha/Parser/Lexer.hs | 11 +-- src/Kroha/Parser/Statements.hs | 2 +- src/Kroha/Scope.hs | 2 +- src/Kroha/Stack.hs | 2 +- src/Kroha/Syntax.hs | 150 ------------------------------- src/Kroha/Syntax/Declarations.hs | 60 +++++++++++++ src/Kroha/Syntax/Primitive.hs | 39 ++++++++ src/Kroha/Syntax/Statements.hs | 62 +++++++++++++ src/Kroha/Syntax/Syntax.hs | 9 ++ src/Kroha/Types.hs | 2 +- 17 files changed, 194 insertions(+), 169 deletions(-) delete mode 100644 src/Kroha/Syntax.hs create mode 100644 src/Kroha/Syntax/Declarations.hs create mode 100644 src/Kroha/Syntax/Primitive.hs create mode 100644 src/Kroha/Syntax/Statements.hs create mode 100644 src/Kroha/Syntax/Syntax.hs diff --git a/Kroha.cabal b/Kroha.cabal index 9d95033..0d1defd 100644 --- a/Kroha.cabal +++ b/Kroha.cabal @@ -35,7 +35,10 @@ executable Kroha Kroha.Parser.Statements Kroha.Scope Kroha.Stack - Kroha.Syntax + Kroha.Syntax.Declarations + Kroha.Syntax.Primitive + Kroha.Syntax.Statements + Kroha.Syntax.Syntax Kroha.Types Paths_Kroha hs-source-dirs: @@ -65,7 +68,10 @@ test-suite Kroha-tests Kroha.Parser.Statements Kroha.Scope Kroha.Stack - Kroha.Syntax + Kroha.Syntax.Declarations + Kroha.Syntax.Primitive + Kroha.Syntax.Statements + Kroha.Syntax.Syntax Kroha.Types Main Paths_Kroha diff --git a/src/Kroha.hs b/src/Kroha.hs index b386c1f..1cd6f00 100644 --- a/src/Kroha.hs +++ b/src/Kroha.hs @@ -11,7 +11,7 @@ import Kroha.Instructions (instructions) import Kroha.Parser.Declarations (parseProgram) import Kroha.Scope (linkProgram) import Kroha.Stack (stack) -import Kroha.Syntax (NodeId, Program, genId, pzip, pzip3) +import Kroha.Syntax.Declarations (NodeId, Program, genId, pzip, pzip3) import Kroha.Types (resolve, typeCastsTree) @@ -32,5 +32,3 @@ kroha name src = Right parsed -> first (showErrors (`Data.HashMap.lookup` rangeTable)) $ compile prog where prog = genId parsed rangeTable = fromList $ toList $ pzip prog parsed - - diff --git a/src/Kroha/Backends/Common.hs b/src/Kroha/Backends/Common.hs index 1a9b87b..560cfe0 100644 --- a/src/Kroha/Backends/Common.hs +++ b/src/Kroha/Backends/Common.hs @@ -1,6 +1,6 @@ module Kroha.Backends.Common (Backend(..), runBackend) where -import Kroha.Syntax (Declaration(..)) +import Kroha.Syntax.Declarations (Declaration(..)) import Kroha.Types (TypeConfig) import Kroha.Instructions (Instruction(Body), Section) diff --git a/src/Kroha/Backends/Nasm.hs b/src/Kroha/Backends/Nasm.hs index e725cc9..2fa056c 100644 --- a/src/Kroha/Backends/Nasm.hs +++ b/src/Kroha/Backends/Nasm.hs @@ -5,7 +5,7 @@ import Data.List (intercalate) import Data.Bifunctor (first) import Data.Maybe (fromJust) -import Kroha.Syntax +import Kroha.Syntax.Syntax import Kroha.Backends.Common import Kroha.Types import Kroha.Instructions (Instruction(..), LabelTarget(..), Target(..), Section) diff --git a/src/Kroha/Errors.hs b/src/Kroha/Errors.hs index 5903409..842a57b 100644 --- a/src/Kroha/Errors.hs +++ b/src/Kroha/Errors.hs @@ -1,6 +1,6 @@ module Kroha.Errors where -import Kroha.Syntax +import Kroha.Syntax.Syntax import Data.Bifunctor (bimap, first) import Data.Either (partitionEithers) import Data.Foldable (toList) diff --git a/src/Kroha/Instructions.hs b/src/Kroha/Instructions.hs index 6eca7cd..f0f328d 100644 --- a/src/Kroha/Instructions.hs +++ b/src/Kroha/Instructions.hs @@ -8,7 +8,7 @@ import Data.Foldable (toList) import Control.Monad (void) import Control.Monad.Zip (mzipWith) -import Kroha.Syntax +import Kroha.Syntax.Syntax import Kroha.Scope import Kroha.Stack import Kroha.Types diff --git a/src/Kroha/Parser/Declarations.hs b/src/Kroha/Parser/Declarations.hs index 5a1ca88..7229c12 100644 --- a/src/Kroha/Parser/Declarations.hs +++ b/src/Kroha/Parser/Declarations.hs @@ -3,7 +3,7 @@ module Kroha.Parser.Declarations where import Kroha.Parser.Lexer -import Kroha.Syntax (Declaration(..), Program (Program)) +import Kroha.Syntax.Declarations (Declaration(..), Program (Program)) import Text.Megaparsec import Data.Bifunctor (first) import Kroha.Parser.Statements (body, statement) diff --git a/src/Kroha/Parser/Lexer.hs b/src/Kroha/Parser/Lexer.hs index d6527f9..f73da82 100644 --- a/src/Kroha/Parser/Lexer.hs +++ b/src/Kroha/Parser/Lexer.hs @@ -2,12 +2,13 @@ module Kroha.Parser.Lexer where +import Control.Monad (void) +import Data.Void (Void) +import Text.Megaparsec +import Text.Megaparsec.Char import qualified Text.Megaparsec.Char.Lexer as L -import Text.Megaparsec.Char -import Text.Megaparsec -import Data.Void (Void) -import Kroha.Syntax -import Control.Monad (void) + +import Kroha.Syntax.Primitive type Parser = Parsec Void String diff --git a/src/Kroha/Parser/Statements.hs b/src/Kroha/Parser/Statements.hs index 5756f26..369adf5 100644 --- a/src/Kroha/Parser/Statements.hs +++ b/src/Kroha/Parser/Statements.hs @@ -2,7 +2,7 @@ module Kroha.Parser.Statements where -import Kroha.Syntax +import Kroha.Syntax.Syntax import Kroha.Parser.Lexer import Text.Megaparsec import Data.Tuple.Extra (curry3) diff --git a/src/Kroha/Scope.hs b/src/Kroha/Scope.hs index 4ed131b..3d0608c 100644 --- a/src/Kroha/Scope.hs +++ b/src/Kroha/Scope.hs @@ -8,7 +8,7 @@ import Data.Foldable (find) import Data.Maybe (fromJust, mapMaybe) import Data.Tree (Tree (..)) -import Kroha.Syntax +import Kroha.Syntax.Syntax import Kroha.Errors diff --git a/src/Kroha/Stack.hs b/src/Kroha/Stack.hs index f8153c5..2034366 100644 --- a/src/Kroha/Stack.hs +++ b/src/Kroha/Stack.hs @@ -4,7 +4,7 @@ import Control.Comonad (extract, duplicate, ($>)) import Data.List (mapAccumL) import Data.Maybe (fromJust) -import Kroha.Syntax +import Kroha.Syntax.Syntax import Kroha.Types type StackRange = (Int, Int) {-offset, size-} diff --git a/src/Kroha/Syntax.hs b/src/Kroha/Syntax.hs deleted file mode 100644 index 2ffa931..0000000 --- a/src/Kroha/Syntax.hs +++ /dev/null @@ -1,150 +0,0 @@ --- Copyright (c) 2020 - 2021 Vorotynsky Maxim - -module Kroha.Syntax where - -import Control.Comonad -import Data.Tree -import Data.List (mapAccumR) -import Control.Monad.Zip (mzipWith) - -type VariableName = String -type RegisterName = String -type InlinedCode = String -type Label = String - -data TypeName - = TypeName String - | PointerType TypeName - deriving (Show, Eq) - -data Literal - = IntegerLiteral Int - deriving (Show, Eq) - -data LValue - = VariableLVal VariableName - | RegisterLVal RegisterName - deriving (Show, Eq) - -data RValue - = AsRValue LValue - | RLiteral Literal - deriving (Show, Eq) - -data LocalVariable - = StackVariable VariableName TypeName - | RegisterVariable VariableName RegisterName - deriving (Show, Eq) - -data Comparator - = Equals | NotEquals - | Greater | Less - deriving (Show, Eq) - -newtype Condition = Condition (RValue, Comparator, RValue) - deriving (Show, Eq) - -data FrameElement d - = Instructions [FrameElement d] d - | VariableDeclaration LocalVariable d - | If Label Condition (FrameElement d) (FrameElement d) d - | Loop Label (FrameElement d) d - | Break Label d - | Call Label [RValue] d - | Assignment LValue RValue d - | Inline InlinedCode d - deriving (Show, Eq, Functor, Foldable, Traversable) - - -data Declaration d - = Frame Label (FrameElement d) d - | GlobalVariable VariableName TypeName Literal d - | ConstantVariable VariableName TypeName Literal d - | ManualFrame Label InlinedCode d - | ManualVariable VariableName TypeName InlinedCode d - deriving (Show, Eq, Functor, Foldable, Traversable) - -data Program d = Program [Declaration d] d - deriving (Show, Eq, Functor, Foldable, Traversable) - -children :: FrameElement d -> [FrameElement d] -children (Instructions xs _) = xs -children (VariableDeclaration x _) = [] -children (If _ _ b e _) = [b, e] -children (Loop _ b _) = [b] -children (Break _ _) = [] -children (Call _ _ _) = [] -children (Assignment _ _ _) = [] -children (Inline _ _) = [] - -getDeclData :: Declaration d -> d -getDeclData (Frame _ _ d) = d -getDeclData (GlobalVariable _ _ _ d) = d -getDeclData (ConstantVariable _ _ _ d) = d -getDeclData (ManualFrame _ _ d) = d -getDeclData (ManualVariable _ _ _ d) = d - - -selector :: (FrameElement d -> a) -> FrameElement d -> Tree a -selector s = unfoldTree (\e -> (s e, children e)) - -selectorProg :: (Declaration d -> a) -> (FrameElement d -> a) -> Program d -> Forest a -selectorProg df sf (Program declarations _) = fmap mapper declarations - where mapper d@(Frame _ frame _) = Node (df d) [selector sf frame] - mapper declaration = Node (df declaration) [] - - -type NodeId = Int - -genId :: Program d -> Program NodeId -genId (Program decls _) = Program (snd $ mapAccumR declId 1 decls) 0 - where genId'' = mapAccumR (\ac b -> (ac + 1, ac)) - declId begin (Frame l fe _) = let (acc, fe') = genId'' (begin + 1) fe in (acc, Frame l fe' begin) - declId begin d = (begin + 1, d $> begin) - -progId :: Program d -> Tree NodeId -progId program = Node 0 $ selectorProg getDeclData extract (genId program) - -instance Comonad FrameElement where - duplicate node@(Instructions c _) = Instructions (map duplicate c) node - duplicate node@(VariableDeclaration v _) = VariableDeclaration v node - duplicate node@(If l c i e _) = If l c (duplicate i) (duplicate e) node - duplicate node@(Loop l b _) = Loop l (duplicate b) node - duplicate node@(Break l _) = Break l node - duplicate node@(Call l a _) = Call l a node - duplicate node@(Assignment l r _) = Assignment l r node - duplicate node@(Inline c _) = Inline c node - - extract (Instructions _ d) = d - extract (VariableDeclaration _ d) = d - extract (If _ _ _ _ d) = d - extract (Loop _ _ d) = d - extract (Break _ d) = d - extract (Call _ _ d) = d - extract (Assignment _ _ d) = d - extract (Inline _ d) = d - -tzip :: FrameElement a -> FrameElement b -> FrameElement (a, b) -tzip (Instructions ca _a) (Instructions cb _b) = Instructions (uncurry tzip <$> zip ca cb) (_a, _b) -tzip (VariableDeclaration va _a) (VariableDeclaration vb _b) | va == vb = VariableDeclaration va (_a, _b) -tzip (If la ca ia ea _a) (If lb cb ib eb _b) | (la, ca) == (lb, cb) = If la ca (tzip ia ib) (tzip ea eb) (_a, _b) -tzip (Loop la ba _a) (Loop lb bb _b) | la == lb = Loop la (tzip ba bb) (_a, _b) -tzip (Break la _a) (Break lb _b) | la == lb = Break la (_a, _b) -tzip (Call la aa _a) (Call lb ab _b) | (la, aa) == (lb, ab) = Call la aa (_a, _b) -tzip (Assignment la ra _a) (Assignment lb rb _b) | (la, ra) == (lb, rb) = Assignment la ra (_a, _b) -tzip (Inline ca _a) (Inline cb _b) | ca == cb = Inline ca (_a, _b) -tzip _ _ = error "can't zip different frame elements" - -dzip :: Declaration a -> Declaration b -> Declaration (a, b) -dzip (Frame la fea _a) (Frame lb feb _b) | la == lb = Frame la (tzip fea feb) (_a, _b) -dzip (GlobalVariable va ta la _a) (GlobalVariable vb tb lb _b) | (va, ta, la) == (vb, tb, lb) = GlobalVariable va ta la (_a, _b) -dzip (ConstantVariable va ta la _a) (ConstantVariable vb tb lb _b) | (va, ta, la) == (vb, tb, lb) = ConstantVariable va ta la (_a, _b) -dzip (ManualFrame la ca _a) (ManualFrame lb cb _b) | (la, ca) == (lb, cb) = ManualFrame la ca (_a, _b) -dzip (ManualVariable va ta ca _a) (ManualVariable vb tb cb _b) | (va, ta, ca) == (vb, tb, cb) = ManualVariable va ta ca (_a, _b) -dzip _ _ = error "can't zip different declarations" - -pzip :: Program a -> Program b -> Program (a, b) -pzip (Program da _a) (Program db _b) = Program (mzipWith dzip da db) (_a, _b) - -pzip3 :: Program a -> Program b -> Program c -> Program (a, b, c) -pzip3 a b c = fmap (\((a, b), c) -> (a, b, c)) (pzip (pzip a b) c) diff --git a/src/Kroha/Syntax/Declarations.hs b/src/Kroha/Syntax/Declarations.hs new file mode 100644 index 0000000..7c296b6 --- /dev/null +++ b/src/Kroha/Syntax/Declarations.hs @@ -0,0 +1,60 @@ +-- Copyright (c) 2021 Vorotynsky Maxim + +module Kroha.Syntax.Declarations where + +import Data.Graph (Forest, Tree(..)) +import Data.List (mapAccumR) +import Control.Comonad (($>), Comonad (extract)) +import Control.Monad.Zip (mzipWith) + +import Kroha.Syntax.Primitive +import Kroha.Syntax.Statements + +data Declaration d + = Frame Label (FrameElement d) d + | GlobalVariable VariableName TypeName Literal d + | ConstantVariable VariableName TypeName Literal d + | ManualFrame Label InlinedCode d + | ManualVariable VariableName TypeName InlinedCode d + deriving (Show, Eq, Functor, Foldable, Traversable) + +data Program d = Program [Declaration d] d + deriving (Show, Eq, Functor, Foldable, Traversable) + +getDeclData :: Declaration d -> d +getDeclData (Frame _ _ d) = d +getDeclData (GlobalVariable _ _ _ d) = d +getDeclData (ConstantVariable _ _ _ d) = d +getDeclData (ManualFrame _ _ d) = d +getDeclData (ManualVariable _ _ _ d) = d + +selectorProg :: (Declaration d -> a) -> (FrameElement d -> a) -> Program d -> Forest a +selectorProg df sf (Program declarations _) = fmap mapper declarations + where mapper d@(Frame _ frame _) = Node (df d) [selector sf frame] + mapper declaration = Node (df declaration) [] + +type NodeId = Int + +genId :: Program d -> Program NodeId +genId (Program decls _) = Program (snd $ mapAccumR declId 1 decls) 0 + where genId'' = mapAccumR (\ac b -> (ac + 1, ac)) + declId begin (Frame l fe _) = let (acc, fe') = genId'' (begin + 1) fe in (acc, Frame l fe' begin) + declId begin d = (begin + 1, d $> begin) + +progId :: Program d -> Tree NodeId +progId program = Node 0 $ selectorProg getDeclData extract (genId program) + +dzip :: Declaration a -> Declaration b -> Declaration (a, b) +dzip (Frame la fea _a) (Frame lb feb _b) | la == lb = Frame la (tzip fea feb) (_a, _b) +dzip (GlobalVariable va ta la _a) (GlobalVariable vb tb lb _b) | (va, ta, la) == (vb, tb, lb) = GlobalVariable va ta la (_a, _b) +dzip (ConstantVariable va ta la _a) (ConstantVariable vb tb lb _b) | (va, ta, la) == (vb, tb, lb) = ConstantVariable va ta la (_a, _b) +dzip (ManualFrame la ca _a) (ManualFrame lb cb _b) | (la, ca) == (lb, cb) = ManualFrame la ca (_a, _b) +dzip (ManualVariable va ta ca _a) (ManualVariable vb tb cb _b) | (va, ta, ca) == (vb, tb, cb) = ManualVariable va ta ca (_a, _b) +dzip _ _ = error "can't zip different declarations" + +pzip :: Program a -> Program b -> Program (a, b) +pzip (Program da _a) (Program db _b) = Program (mzipWith dzip da db) (_a, _b) + +pzip3 :: Program a -> Program b -> Program c -> Program (a, b, c) +pzip3 a b c = fmap (\((a, b), c) -> (a, b, c)) (pzip (pzip a b) c) + diff --git a/src/Kroha/Syntax/Primitive.hs b/src/Kroha/Syntax/Primitive.hs new file mode 100644 index 0000000..4555a8e --- /dev/null +++ b/src/Kroha/Syntax/Primitive.hs @@ -0,0 +1,39 @@ +module Kroha.Syntax.Primitive where + +type VariableName = String +type RegisterName = String +type InlinedCode = String +type Label = String + +data TypeName + = TypeName String + | PointerType TypeName + deriving (Show, Eq) + +data Literal + = IntegerLiteral Int + deriving (Show, Eq) + +data LValue + = VariableLVal VariableName + | RegisterLVal RegisterName + deriving (Show, Eq) + +data RValue + = AsRValue LValue + | RLiteral Literal + deriving (Show, Eq) + +data LocalVariable + = StackVariable VariableName TypeName + | RegisterVariable VariableName RegisterName + deriving (Show, Eq) + +data Comparator + = Equals | NotEquals + | Greater | Less + deriving (Show, Eq) + +newtype Condition = Condition (RValue, Comparator, RValue) + deriving (Show, Eq) + diff --git a/src/Kroha/Syntax/Statements.hs b/src/Kroha/Syntax/Statements.hs new file mode 100644 index 0000000..0c4a571 --- /dev/null +++ b/src/Kroha/Syntax/Statements.hs @@ -0,0 +1,62 @@ +-- Copyright (c) 2021 Vorotynsky Maxim + +module Kroha.Syntax.Statements where + +import Data.Tree (Tree, unfoldTree) +import Control.Comonad + +import Kroha.Syntax.Primitive + +data FrameElement d + = Instructions [FrameElement d] d + | VariableDeclaration LocalVariable d + | If Label Condition (FrameElement d) (FrameElement d) d + | Loop Label (FrameElement d) d + | Break Label d + | Call Label [RValue] d + | Assignment LValue RValue d + | Inline InlinedCode d + deriving (Show, Eq, Functor, Foldable, Traversable) + +children :: FrameElement d -> [FrameElement d] +children (Instructions xs _) = xs +children (VariableDeclaration x _) = [] +children (If _ _ b e _) = [b, e] +children (Loop _ b _) = [b] +children (Break _ _) = [] +children (Call _ _ _) = [] +children (Assignment _ _ _) = [] +children (Inline _ _) = [] + +selector :: (FrameElement d -> a) -> FrameElement d -> Tree a +selector s = unfoldTree (\e -> (s e, children e)) + +instance Comonad FrameElement where + duplicate node@(Instructions c _) = Instructions (map duplicate c) node + duplicate node@(VariableDeclaration v _) = VariableDeclaration v node + duplicate node@(If l c i e _) = If l c (duplicate i) (duplicate e) node + duplicate node@(Loop l b _) = Loop l (duplicate b) node + duplicate node@(Break l _) = Break l node + duplicate node@(Call l a _) = Call l a node + duplicate node@(Assignment l r _) = Assignment l r node + duplicate node@(Inline c _) = Inline c node + + extract (Instructions _ d) = d + extract (VariableDeclaration _ d) = d + extract (If _ _ _ _ d) = d + extract (Loop _ _ d) = d + extract (Break _ d) = d + extract (Call _ _ d) = d + extract (Assignment _ _ d) = d + extract (Inline _ d) = d + +tzip :: FrameElement a -> FrameElement b -> FrameElement (a, b) +tzip (Instructions ca _a) (Instructions cb _b) = Instructions (uncurry tzip <$> zip ca cb) (_a, _b) +tzip (VariableDeclaration va _a) (VariableDeclaration vb _b) | va == vb = VariableDeclaration va (_a, _b) +tzip (If la ca ia ea _a) (If lb cb ib eb _b) | (la, ca) == (lb, cb) = If la ca (tzip ia ib) (tzip ea eb) (_a, _b) +tzip (Loop la ba _a) (Loop lb bb _b) | la == lb = Loop la (tzip ba bb) (_a, _b) +tzip (Break la _a) (Break lb _b) | la == lb = Break la (_a, _b) +tzip (Call la aa _a) (Call lb ab _b) | (la, aa) == (lb, ab) = Call la aa (_a, _b) +tzip (Assignment la ra _a) (Assignment lb rb _b) | (la, ra) == (lb, rb) = Assignment la ra (_a, _b) +tzip (Inline ca _a) (Inline cb _b) | ca == cb = Inline ca (_a, _b) +tzip _ _ = error "can't zip different frame elements" diff --git a/src/Kroha/Syntax/Syntax.hs b/src/Kroha/Syntax/Syntax.hs new file mode 100644 index 0000000..0db6358 --- /dev/null +++ b/src/Kroha/Syntax/Syntax.hs @@ -0,0 +1,9 @@ +module Kroha.Syntax.Syntax +( module Kroha.Syntax.Primitive +, module Kroha.Syntax.Statements +, module Kroha.Syntax.Declarations +) where + +import Kroha.Syntax.Primitive +import Kroha.Syntax.Statements +import Kroha.Syntax.Declarations diff --git a/src/Kroha/Types.hs b/src/Kroha/Types.hs index 54ac409..8d2958d 100644 --- a/src/Kroha/Types.hs +++ b/src/Kroha/Types.hs @@ -8,7 +8,7 @@ import Control.Monad (join) import Data.List.Extra (elemIndex) import Data.Either.Extra (maybeToEither) -import Kroha.Syntax +import Kroha.Syntax.Syntax import Kroha.Scope import Kroha.Errors