refactor(ast): split Kroha.Syntax into modules

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

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
-
-

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)
 

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)

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)

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

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)

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

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)

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
 
 

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-}

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)
+

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)
+