release(v1.3): better syntax

vorotynsky · Nov 23, 2021 · 017d949 · 017d949
2 parents 68d44fe + 4c4c072
commit 017d949
Show file tree

Hide file tree

Showing 31 changed files with 635 additions and 497 deletions.
diff --git a/Kroha.cabal b/Kroha.cabal
@@ -5,7 +5,7 @@ cabal-version: 1.12
 -- see: https://github.com/sol/hpack
 
 name:           Kroha
-version:        1.2.2.0
+version:        1.3.1.0
 description:    Please see the README on GitHub at <https://github.com/vorotynsky/Kroha#readme>
 homepage:       https://github.com/vorotynsky/Kroha#readme
 bug-reports:    https://github.com/vorotynsky/Kroha/issues
@@ -26,25 +26,31 @@ executable Kroha
   main-is: Main.hs
   other-modules:
       Kroha
-      Kroha.Ast
       Kroha.Backends.Common
       Kroha.Backends.Nasm
       Kroha.Errors
       Kroha.Instructions
-      Kroha.Parser
+      Kroha.Parser.Declarations
+      Kroha.Parser.Lexer
+      Kroha.Parser.Statements
       Kroha.Scope
       Kroha.Stack
+      Kroha.Syntax.Declarations
+      Kroha.Syntax.Primitive
+      Kroha.Syntax.Statements
+      Kroha.Syntax.Syntax
       Kroha.Types
       Paths_Kroha
   hs-source-dirs:
       src
+  ghc-options: -XTupleSections -XDeriveTraversable -XRankNTypes -XImplicitParams -XTypeFamilies
   build-depends:
       base >=4.7 && <5
     , comonad >=5 && <5.1
     , containers ==0.6.*
     , extra >=1.0 && <1.8
     , hashmap >=1.0.0 && <1.4
-    , parsec >=3.1.0 && <=3.1.14.0
+    , megaparsec >=8.0.0 && <=10.0.0
   default-language: Haskell2010
 
 test-suite Kroha-tests
@@ -53,20 +59,26 @@ test-suite Kroha-tests
   other-modules:
       Case
       Kroha
-      Kroha.Ast
       Kroha.Backends.Common
       Kroha.Backends.Nasm
       Kroha.Errors
       Kroha.Instructions
-      Kroha.Parser
+      Kroha.Parser.Declarations
+      Kroha.Parser.Lexer
+      Kroha.Parser.Statements
       Kroha.Scope
       Kroha.Stack
+      Kroha.Syntax.Declarations
+      Kroha.Syntax.Primitive
+      Kroha.Syntax.Statements
+      Kroha.Syntax.Syntax
       Kroha.Types
       Main
       Paths_Kroha
   hs-source-dirs:
       test
       src
+  ghc-options: -XTupleSections -XDeriveTraversable -XRankNTypes -XImplicitParams -XTypeFamilies
   build-depends:
       Diff >=0.2 && <0.5
     , HUnit ==1.6.*
@@ -75,5 +87,5 @@ test-suite Kroha-tests
     , containers ==0.6.*
     , extra >=1.0 && <1.8
     , hashmap >=1.0.0 && <1.4
-    , parsec >=3.1.0 && <=3.1.14.0
+    , megaparsec >=8.0.0 && <=10.0.0
   default-language: Haskell2010
diff --git a/package.yaml b/package.yaml
@@ -1,5 +1,5 @@
 name:                Kroha
-version:             1.2.2.0
+version:             1.3.1.0
 github:              "vorotynsky/Kroha"
 license:             GPL-3
 author:              "Vorotynsky Maxim"
@@ -18,10 +18,17 @@ extra-source-files:
 # common to point users to the README.md file.
 description:         Please see the README on GitHub at <https://github.com/vorotynsky/Kroha#readme>
 
+ghc-options:
+- -XTupleSections
+- -XDeriveTraversable
+- -XRankNTypes
+- -XImplicitParams
+- -XTypeFamilies
+
 dependencies:
 - base >= 4.7 && < 5
 - containers >= 0.6 && < 0.7
-- parsec >= 3.1.0 && <= 3.1.14.0
+- megaparsec >= 8.0.0 && <= 10.0.0
 - extra >= 1.0 && < 1.8
 - comonad >= 5 && < 5.1
 - hashmap >= 1.0.0 && < 1.4

diff --git a/src/Kroha.hs b/src/Kroha.hs
@@ -1,36 +1,34 @@
 module Kroha (kroha) where
 
-import           Data.Bifunctor        (first)
-import           Data.Foldable         (toList)
-import           Data.HashMap          (fromList, lookup)
+import           Data.Bifunctor            (first)
+import           Data.Foldable             (toList)
+import           Data.HashMap              (fromList, lookup)
 
-import           Kroha.Ast             (NodeId, Program, genId, pzip, pzip3)
-import           Kroha.Backends.Common (runBackend, typeConfig)
-import           Kroha.Backends.Nasm   (nasm)
-import           Kroha.Errors          (Result, showErrors)
-import           Kroha.Instructions    (instructions)
-import           Kroha.Parser          (parse)
-import           Kroha.Scope           (linkProgram)
-import           Kroha.Stack           (stack)
-import           Kroha.Types           (resolve, typeCastsTree)
+import           Kroha.Backends.Common     (runBackend, typeConfig)
+import           Kroha.Backends.Nasm       (nasm)
+import           Kroha.Errors              (Result, showErrors)
+import           Kroha.Instructions        (instructions)
+import           Kroha.Parser.Declarations (parseProgram)
+import           Kroha.Scope               (linkProgram)
+import           Kroha.Stack               (stack)
+import           Kroha.Syntax.Declarations (NodeId, Program, genId, pzip, pzip3)
+import           Kroha.Types               (resolve, typeCastsTree)
 
 
 compile :: Program NodeId -> Result String
 compile program = do
                   scopes  <- linkProgram program
                   let tc   = typeConfig nasm
                   casts   <- typeCastsTree tc scopes
-                  types   <- resolve tc (pzip program casts)
+                  _       <- resolve tc (pzip program casts)
                   let stackRanges = stack tc program
                   let prepared = instructions (pzip3 stackRanges (fmap snd scopes) program)
                   return (runBackend nasm prepared)
 
 kroha :: String -> String -> Either String String
 kroha name src =
-      case parse name src of
+      case parseProgram name src of
            Left err   -> Left err
            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/Ast.hs b/src/Kroha/Ast.hs
diff --git a/src/Kroha/Backends/Common.hs b/src/Kroha/Backends/Common.hs
@@ -1,16 +1,16 @@
 module Kroha.Backends.Common (Backend(..), runBackend) where
 
-import Kroha.Ast (Declaration(..))
+import Kroha.Syntax.Declarations (Declaration(..))
 import Kroha.Types (TypeConfig)
 import Kroha.Instructions (Instruction(Body), Section)
 
-import Control.Monad (join, void)
+import Control.Monad (void)
 import Data.Tree (Tree(..))
 import Data.Char (isSpace)
 import Data.Semigroup (Min(Min, getMin))
 
 
-data Backend = Backend 
+data Backend = Backend
     { typeConfig :: TypeConfig
     , instruction :: Instruction -> [String]
     , bodyWrap :: [String] -> [String]
@@ -20,24 +20,24 @@ data Backend = Backend
 
 
 makeFix :: Backend -> Tree [Instruction] -> [String]
-makeFix backend (Node i c) = join . fmap asmFix $ i
-    where asmFix (Body _ i) = fmap ((++) (indent backend)) . bodyWrap backend $ makeFix backend (c !! i)
+makeFix backend (Node i c) = i >>= asmFix
+    where asmFix (Body _ i) = fmap (indent backend ++) . bodyWrap backend $ makeFix backend (c !! i)
           asmFix i          = instruction backend i
 
 unindentManual :: String -> [String]
 unindentManual code = fmap (drop minIndent) lined
     where lined = let (h:t) = (\l -> if null l then [""] else l) $ lines code in if null h then t else h:t
-          filterEmpty = filter (not . null . filter (not . isSpace))
+          filterEmpty = filter (not . all isSpace)
           minIndent = getMin . foldMap (Min . length . takeWhile isSpace) . filterEmpty $ lined
 
 backendDeclaration :: Backend -> Declaration () -> Tree [Instruction] -> String
-backendDeclaration b decl@(Frame _ frame _)          ti = declaration b decl (makeFix b ti)
-backendDeclaration b decl@(GlobalVariable   _ _ l _) _  = declaration b decl []
-backendDeclaration b decl@(ConstantVariable _ _ l _) _  = declaration b decl []
-backendDeclaration b decl@(ManualFrame _ c _)        _  = declaration b decl (unindentManual c)
-backendDeclaration b decl@(ManualVariable _ _ c _)   _  = declaration b decl (unindentManual c)
+backendDeclaration b decl@(Frame {})              ti = declaration b decl (makeFix b ti)
+backendDeclaration b decl@(GlobalVariable   {})    _  = declaration b decl []
+backendDeclaration b decl@(ConstantVariable {})    _  = declaration b decl []
+backendDeclaration b decl@(ManualFrame _ c _)      _  = declaration b decl (unindentManual c)
+backendDeclaration b decl@(ManualVariable _ _ c _) _  = declaration b decl (unindentManual c)
 
 runBackend :: Backend -> [(Section, Declaration d, Tree [Instruction])] -> String
-runBackend backend = join . fmap (mapper)
+runBackend backend = (>>= mapper)
     where mapper (s, d, i) = section backend s (backendDeclaration backend (void d) i)