Moved from Parsec to Megaparsec (parapluu#670)

* Moved from Parsec to MegaParsec

* Refactoring

* Add stack setup to Makefile

This should automatically update the dependencies of encorec when they
are changed.

* Move line in Makefile

* Add --system-ghc to stack calls

* Rename install-deps to stack-setup

* Remove old reference to "bundles"

* More Makefile cleanup

* Remove stack dependency for make clean

Author: EliasC

Makefile

@@ -14,12 +14,12 @@ all: encorec
 typecheck:
 	cabal build --ghc-option=-fno-code
 
-encorec: dirs pony install-deps
+encorec: dirs pony stack-setup
 	export ENCORE_MODULES="$(CURDIR)/modules/" && \
-	stack --install-ghc --system-ghc install --local-bin-path $(RELEASE_DIR)
+	stack install --system-ghc --local-bin-path $(RELEASE_DIR)
 
-install-deps:
-	stack --install-ghc --system-ghc install --dependencies-only
+stack-setup:
+	stack setup --system-ghc
 
 test: encorec
 	make -C $(SRC_DIR) test
@@ -29,7 +29,7 @@ coverage: dirs pony
 	find src -name "*.tix" -print0 | xargs -0 rm -rf;
 	cabal clean;
 	cabal configure --enable-tests --enable-coverage;
-	ENCORE_BUNDLES="$(CURDIR)/bundles/" cabal build;
+	ENCORE_MODULES="$(CURDIR)/modules/" cabal build;
 	cp dist/build/encorec/encorec $(RELEASE_DIR);
 	-make -C $(SRC_DIR) test;
 	mkdir -p coverage;
@@ -42,10 +42,10 @@ coverage: dirs pony
 SET_DIR=$(RUNTIME_DIR)/set
 FUTURE_DIR=$(RUNTIME_DIR)/future
 ENCORE_DIR=$(RUNTIME_DIR)/encore
-doc: install-deps
-	export ENCORE_BUNDLES="$(CURDIR)/bundles/" && \
+doc: stack-setup
+	export ENCORE_MODULES="$(CURDIR)/modules/" && \
 	make -C doc/encore/ && \
-	stack haddock
+	stack haddock --system-ghc
 
 dirs: $(INC_DIR) $(LIB_DIR)
 
@@ -108,7 +108,7 @@ pony: dirs $(PONY_INC)
 	cp -r $(RANGE_LIB) $(LIB_DIR)
 
 clean:
-	stack clean
+	rm -rf .stack-work/dist
 	rm -rf dist
 	make -C doc/encore clean
 	make -C $(SRC_DIR) clean

README.md

@@ -116,6 +116,8 @@ Alternatively, run: `brew update; brew install premake`
 
 If you have homebrew, you can run `brew install haskell-stack`. Otherwise,
 use these [installation instructions](http://docs.haskellstack.org/en/stable/README/#how-to-install).
+You might have to run `stack update` in order to get the latest version
+of all the dependencies.
 
 ##### Installing `pcre2`
 

encore.cabal

@@ -36,7 +36,8 @@ executable encorec
                , hashable
                , hpc
                , mtl ==2.2.*
-               , parsec >=3.1.7 && <3.2
+               , megaparsec >= 5.1.2
+               , semigroups
                , pretty >=1.1 && <1.2
                , process >=1.2 && <1.3
                , template-haskell

modules/standard/String.enc

@@ -27,7 +27,7 @@ def string_from_char(c : char) : String
   let
     s = embed (embed char* end) encore_alloc(*_ctx, 2); end
   in
-    new String(embed (embed char* end) *#{s} = #{c}; #{s}; end)
+    new String(embed (embed char* end) (*#{s}) = #{c}; #{s}; end)
 
 def string_from_array(arr : [char]) : String
   let
@@ -36,7 +36,7 @@ def string_from_array(arr : [char]) : String
     p = s
   in{
     for c in arr
-      embed void *#{p}++ = #{c}; end;
+      embed void (*#{p}++) = #{c}; end;
     new String(s)
   }
 

src/back/CodeGen/CCodeNames.hs

@@ -19,7 +19,6 @@ import CCode.Main
 import Data.List
 import Data.Char
 import Data.String.Utils
-import Text.Parsec.Pos as P
 
 import qualified AST.AST as A
 
@@ -251,7 +250,7 @@ qualifiedToString ID.QName{ID.qnsource = Nothing, ID.qnlocal} = show qnlocal
 qualifiedToString ID.QName{ID.qnsource = Just s, ID.qnlocal} =
   sourceToString s ++ show qnlocal
 
-sourceToString :: SourceName -> String
+sourceToString :: FilePath -> String
 sourceToString = map translateSep . filter (/='.') . dropEnc
   where
     translateSep '/' = '_'

src/back/CodeGen/Expr.hs

@@ -11,9 +11,6 @@ import CodeGen.Type
 import qualified CodeGen.Context as Ctx
 import CodeGen.DTrace
 
-import qualified Text.Parsec as Parsec
-import qualified Text.Parsec.String as PString
-
 import CCode.Main
 import CCode.PrettyCCode
 
@@ -572,7 +569,7 @@ instance Translatable A.Expr (State Ctx.Context (CCode Lval, CCode Stat)) where
     | isActive && isFuture = delegateUse callTheMethodFuture "fut"
     | otherwise = error $ "Expr.hs: Don't know how to call target of type " ++
                           Ty.showWithKind targetTy ++
-                          " at " ++ show (A.getPos call)
+                          " at " ++ Meta.showPos (A.getMeta call)
         where
           targetTy = A.getType target
           retTy = A.getType call
@@ -1305,7 +1302,7 @@ targetNullCheck ntarget target name meta op =
        String op,
        String (show (PP.ppExpr target)),
        String (show name),
-       String (show (Meta.getPos meta))]
+       String (Meta.showPos meta)]
 
 runtimeTypeArguments [] = return (nullVar, Skip)
 runtimeTypeArguments typeArgs = do

src/front/ModuleExpander.hs

@@ -21,10 +21,10 @@ import System.Directory(doesFileExist)
 import Data.Map.Strict(Map)
 import qualified Data.Map.Strict as Map
 import Data.List
-import Text.Parsec.Pos(SourceName, initialPos)
+import Text.Megaparsec(parseErrorPretty, initialPos)
 import Debug.Trace
 
-type ProgramTable = Map SourceName Program
+type ProgramTable = Map FilePath Program
 
 dirAndName = dirname' &&& basename
   where
@@ -56,7 +56,7 @@ stdLib source = [lib "String"]
                     ,ihiding = Nothing
                     }
 
-addStdLib :: SourceName -> ModuleDecl -> [ImportDecl] -> [ImportDecl]
+addStdLib :: FilePath -> ModuleDecl -> [ImportDecl] -> [ImportDecl]
 addStdLib source NoModule imports = stdLib source ++ imports
 addStdLib source Module{modname} imports =
   filter ((/= explicitNamespace [modname]) . itarget) (stdLib source) ++ imports
@@ -118,7 +118,7 @@ buildModulePath (NSExplicit ns) =
      then moduleName
      else moduleDir </> moduleName
 
-findSource :: [FilePath] -> FilePath -> ImportDecl -> IO SourceName
+findSource :: [FilePath] -> FilePath -> ImportDecl -> IO FilePath
 findSource importDirs sourceDir Import{itarget} = do
   let modulePath = buildModulePath itarget
       sources = nub $
@@ -149,7 +149,7 @@ importModule importDirs preludePaths table source
                  else raw
       ast <- case parseEncoreProgram source code of
                Right ast  -> return ast
-               Left error -> abort $ show error
+               Left error -> abort $ parseErrorPretty error
       if moduledecl ast == NoModule
       then abort $ "No module in file " ++ source ++ ". Aborting!"
       else let (sourceDir, sourceName) = dirAndName source

src/front/TopLevel.hs

@@ -17,6 +17,7 @@ import System.Process
 import System.Posix.Directory
 import Data.List
 import Data.List.Utils(split)
+import qualified Data.List.NonEmpty as NE(head)
 import Data.Maybe
 import Data.String.Utils
 import Control.Monad
@@ -26,6 +27,8 @@ import Language.Haskell.TH -- for Template Haskell hackery
 import Text.Printf
 import qualified Text.PrettyPrint.Boxes as Box
 import System.FilePath (splitPath, joinPath)
+import Text.Megaparsec.Error(errorPos, parseErrorTextPretty)
+import AST.Meta(showSourcePos)
 
 import Makefile
 import Utils
@@ -307,7 +310,10 @@ main =
        verbose options "== Parsing =="
        ast <- case parseEncoreProgram sourceName code of
                 Right ast  -> return ast
-                Left error -> abort $ show error
+                Left error -> do
+                  let pos = NE.head $ errorPos error
+                  abort $ showSourcePos pos ++ ":\n" ++
+                          parseErrorTextPretty error
 
        verbose options "== Importing modules =="
        programTable <- buildProgramTable importDirs preludePaths ast

src/ir/AST/AST.hs

@@ -13,7 +13,7 @@ import Data.List
 import Data.Map.Strict(Map)
 import qualified Data.Map.Strict as Map
 import Data.Maybe
-import Text.Parsec(SourcePos, SourceName)
+import Text.Megaparsec(SourcePos)
 
 import Identifiers
 import Types
@@ -23,7 +23,7 @@ data FileDescriptor = Stdout | Stderr
   deriving (Show, Eq)
 
 data Program = Program {
-  source :: SourceName,
+  source :: FilePath,
   moduledecl :: ModuleDecl,
   etl :: [EmbedTL],
   imports :: [ImportDecl],
@@ -97,7 +97,7 @@ data ImportDecl = Import {
       ihiding :: Maybe [Name],
       iselect :: Maybe [Name],
       ialias :: Maybe Namespace,
-      isource :: Maybe SourceName
+      isource :: Maybe FilePath
     } deriving (Show)
 
 instance HasMeta ImportDecl where
@@ -170,14 +170,14 @@ data Function =
       funheader :: FunctionHeader,
       funbody   :: Expr,
       funlocals :: [Function],
-      funsource :: SourceName
+      funsource :: FilePath
     }
   | MatchingFunction {
       funmeta         :: Meta Function,
       matchfunheaders :: [FunctionHeader],
       matchfunbodies  :: [Expr],
       funlocals       :: [Function],
-      funsource       :: SourceName
+      funsource       :: FilePath
     } deriving (Show)
 
 functionName = hname . funheader
@@ -374,7 +374,7 @@ conjunctiveTypesFromComposition _ = []
 -- | @translateCompositionNamespace table@ gives the included
 -- traits of a class (if any) the namespace specified by @table@.
 translateCompositionNamespace ::
-  Map SourceName Namespace -> Maybe TraitComposition -> Maybe TraitComposition
+  Map FilePath Namespace -> Maybe TraitComposition -> Maybe TraitComposition
 translateCompositionNamespace table Nothing = Nothing
 translateCompositionNamespace table (Just tc@TraitLeaf{tcname}) =
   let source = getRefSourceFile tcname
@@ -496,7 +496,7 @@ replaceHeaderTypes bindings header =
           p{ptype = replaceTypeVars bindings ptype}
 
 translateHeaderNamespace ::
-  Map SourceName Namespace -> FunctionHeader -> FunctionHeader
+  Map FilePath Namespace -> FunctionHeader -> FunctionHeader
 translateHeaderNamespace table header =
     let hparams' = map (translateParamType table) (hparams header)
         htype' = translateTypeNamespace table (htype header)

src/ir/AST/Desugarer.hs

@@ -6,6 +6,7 @@ import qualified AST.Meta as Meta
 import AST.PrettyPrinter
 import AST.Util
 import Types
+import Text.Megaparsec
 
 import qualified Data.List as List
 
@@ -359,4 +360,4 @@ desugar e = e
 assertionFailed emeta assert =
   StringLiteral (cloneMeta emeta) $
                 "Assertion failed at " ++
-                show (Meta.getPos emeta) ++ ":\n" ++ assert
+                Meta.showPos emeta ++ ":\n" ++ assert

src/ir/AST/Meta.hs

@@ -1,7 +1,8 @@
 module AST.Meta where
 
-import Text.Parsec(SourcePos, sourceLine, sourceColumn)
+import Text.Megaparsec(unPos, SourcePos(..))
 import Data.Maybe
+import Text.Printf
 
 import Types
 
@@ -21,14 +22,17 @@ meta pos = Meta {sourcePos = pos
                 ,sugared = Nothing
                 ,metaInfo = Unspecified}
 
-getPos :: Meta a -> SourcePos
-getPos = sourcePos
+showSourcePos pos =
+  let line = unPos (sourceLine pos)
+      col = unPos (sourceColumn pos)
+      file = sourceName pos
+  in printf "%s (line %d, column %d)" (show file) line col
 
-getLine :: Meta a -> Int
-getLine = sourceLine . sourcePos
+showPos :: Meta a -> String
+showPos = showSourcePos . sourcePos
 
-getCol :: Meta a -> Int
-getCol = sourceColumn . sourcePos
+getPos :: Meta a -> SourcePos
+getPos = sourcePos
 
 setType :: Type -> Meta a -> Meta a
 setType newType m = m {metaType = Just newType}

src/ir/Identifiers.hs

@@ -10,15 +10,14 @@ module Identifiers where
 
 import Data.List
 import Data.Maybe
-import Text.Parsec.Pos as P
 
 -- | An identifier of a variable, a method, a parameter, etc.
 newtype Name = Name String deriving (Read, Eq, Ord)
 instance Show Name where
   show (Name n) = n
 
 data Namespace = NSExplicit [Name]
-               | NSImplicit SourceName
+               | NSImplicit FilePath
                  deriving(Eq, Ord)
 
 instance Show Namespace where
@@ -41,7 +40,7 @@ isExplicitNamespace _ = False
 
 data QualifiedName =
     QName{qnspace  :: Maybe Namespace
-         ,qnsource :: Maybe SourceName
+         ,qnsource :: Maybe FilePath
          ,qnlocal  :: Name
          } deriving(Eq)
 
@@ -60,7 +59,7 @@ qName = qLocal . Name
 setNamespace :: Namespace -> QualifiedName -> QualifiedName
 setNamespace ns qname = qname{qnspace = Just ns}
 
-setSourceFile :: SourceName -> QualifiedName -> QualifiedName
+setSourceFile :: FilePath -> QualifiedName -> QualifiedName
 setSourceFile source qname = qname{qnsource = Just source}
 
 isLocalQName :: QualifiedName -> Bool