diff --git a/language-ocaml.cabal b/language-ocaml.cabal --- a/language-ocaml.cabal +++ b/language-ocaml.cabal @@ -1,5 +1,5 @@ Name: language-ocaml -Version: 0.1.31 +Version: 0.2.0 Synopsis: Language tools for manipulating OCaml programs in Haskell Description: Language tools for manipulating OCaml programs in Haskell. Curently includes a Alex/Happy parser, and a pretty-printer. @@ -22,19 +22,23 @@ hs-source-dirs: lib, test pkgconfig-depends: zlib build-tools: alex, happy - build-depends: array >= 0.5 && < 0.6, - base >= 4.9 && < 4.11, - containers >= 0.5 && < 0.7, - data-default >= 0.7 && < 0.8, - extensible-effects >= 3.0 && < 3.1, - interpolate >= 0.2 && < 0.3, - lens >= 4.16 && < 4.17, - megaparsec >= 6.0 && < 6.5, - mtl >= 2.2 && < 2.3, - prettyprinter >= 1.2 && < 1.3, - string-qq >= 0.0 && < 0.1, - tasty >= 1.0 && < 1.1, - tasty-hunit >= 0.9 && < 0.11 + build-depends: array >= 0.5 && < 0.6, + base >= 4.9 && < 4.11, + containers >= 0.5 && < 0.7, + data-default >= 0.7 && < 0.8, + directory >= 1.3 && < 1.4, + extensible-effects >= 3.0 && < 3.1, + extra >= 1.6 && < 1.7, + filepath >= 1.4 && < 1.5, + interpolate >= 0.2 && < 0.3, + lens >= 4.16 && < 4.17, + megaparsec >= 6.0 && < 6.5, + mtl >= 2.2 && < 2.3, + prettyprinter >= 1.2 && < 1.3, + string-qq >= 0.0 && < 0.1, + tasty >= 1.0 && < 1.1, + tasty-golden >= 2.3 && < 2.4, + tasty-hunit >= 0.9 && < 0.11 exposed-modules: Language.OCaml.Parser.Common Language.OCaml.Definitions.Parsing.ASTHelper.Exception @@ -61,8 +65,6 @@ Language.OCaml.Parser Language.OCaml.Parser.Generator.Lexer Language.OCaml.Parser.Generator.Parser - Language.OCaml.Parser.Internal - Language.OCaml.Parser.Utils.Utils Language.OCaml.PrettyPrinter Language.OCaml.PrettyPrinter.Internal other-modules: @@ -70,100 +72,6 @@ Language.OCaml.Definitions.StdLib.Lexing Language.OCaml.Definitions.StdLib.Parsing Language.OCaml.Utils - Language.OCaml.Parser.AndTypeDeclaration - Language.OCaml.Parser.Attribute - Language.OCaml.Parser.Attributes - Language.OCaml.Parser.AttrId - Language.OCaml.Parser.BarConstructorDeclaration - Language.OCaml.Parser.Constant - Language.OCaml.Parser.ConstrIdent - Language.OCaml.Parser.ConstrLongident - Language.OCaml.Parser.ConstructorArguments - Language.OCaml.Parser.ConstructorDeclaration - Language.OCaml.Parser.ConstructorDeclarations - Language.OCaml.Parser.CoreType - Language.OCaml.Parser.CoreType2 - Language.OCaml.Parser.CoreTypeCommaList - Language.OCaml.Parser.CoreTypeList - Language.OCaml.Parser.CoreTypeNoAttr - Language.OCaml.Parser.Expr - Language.OCaml.Parser.ExprSemiList - Language.OCaml.Parser.FunBinding - Language.OCaml.Parser.FunDef - Language.OCaml.Parser.GeneralizedConstructorArguments - Language.OCaml.Parser.Implementation - Language.OCaml.Parser.Label - Language.OCaml.Parser.LabelDeclaration - Language.OCaml.Parser.LabelDeclarationSemi - Language.OCaml.Parser.LabelDeclarations - Language.OCaml.Parser.LabelLongident - Language.OCaml.Parser.LabeledSimpleExpr - Language.OCaml.Parser.LabeledSimplePattern - Language.OCaml.Parser.LblExpr - Language.OCaml.Parser.LblExprList - Language.OCaml.Parser.LblPattern - Language.OCaml.Parser.LblPatternList - Language.OCaml.Parser.LetBinding - Language.OCaml.Parser.LetBindingBody - Language.OCaml.Parser.LetBindings - Language.OCaml.Parser.MatchCase - Language.OCaml.Parser.MatchCases - Language.OCaml.Parser.ModExtLongident - Language.OCaml.Parser.ModLongident - Language.OCaml.Parser.ModuleBinding - Language.OCaml.Parser.ModuleBindingBody - Language.OCaml.Parser.ModuleExpr - Language.OCaml.Parser.MutableFlag - Language.OCaml.Parser.NonRecFlag - Language.OCaml.Parser.OpenStatement - Language.OCaml.Parser.Operator - Language.OCaml.Parser.OptBar - Language.OCaml.Parser.OptPatternTypeConstraint - Language.OCaml.Parser.OptTypeConstraint - Language.OCaml.Parser.OptSemi - Language.OCaml.Parser.OptionalTypeParameter - Language.OCaml.Parser.OptionalTypeParameters - Language.OCaml.Parser.OptionalTypeVariable - Language.OCaml.Parser.OverrideFlag - Language.OCaml.Parser.Pattern - Language.OCaml.Parser.PatternGen - Language.OCaml.Parser.PatternNoExn - Language.OCaml.Parser.PatternSemiList - Language.OCaml.Parser.Payload - Language.OCaml.Parser.PolyTypeNoAttr - Language.OCaml.Parser.PostItemAttribute - Language.OCaml.Parser.PostItemAttributes - Language.OCaml.Parser.PrivateFlag - Language.OCaml.Parser.RecFlag - Language.OCaml.Parser.RecordExpr - Language.OCaml.Parser.SeqExpr - Language.OCaml.Parser.SigExceptionDeclaration - Language.OCaml.Parser.SimpleCoreType - Language.OCaml.Parser.SimpleCoreType2 - Language.OCaml.Parser.SimpleCoreTypeOrTuple - Language.OCaml.Parser.SimpleDelimitedPattern - Language.OCaml.Parser.SimpleExpr - Language.OCaml.Parser.SimplePattern - Language.OCaml.Parser.SimpleLabeledExprList - Language.OCaml.Parser.SimplePatternNotIdent - Language.OCaml.Parser.SingleAttrId - Language.OCaml.Parser.StrExceptionDeclaration - Language.OCaml.Parser.StrictBinding - Language.OCaml.Parser.Structure - Language.OCaml.Parser.StructureItem - Language.OCaml.Parser.TestUtils - Language.OCaml.Parser.Tokens - Language.OCaml.Parser.TypeConstraint - Language.OCaml.Parser.TypeDeclaration - Language.OCaml.Parser.TypeDeclarations - Language.OCaml.Parser.TypeKind - Language.OCaml.Parser.TypeVariable - Language.OCaml.Parser.TypeVariance - Language.OCaml.Parser.TypeLongident - Language.OCaml.Parser.Utils.Combinators - Language.OCaml.Parser.Utils.Types - Language.OCaml.Parser.ValIdent - Language.OCaml.Parser.ValLongident Language.OCaml.PrettyPrinter.ArgLabel Language.OCaml.PrettyPrinter.Case Language.OCaml.PrettyPrinter.Constant @@ -200,27 +108,36 @@ main-is: Main.hs build-depends: language-ocaml, base, + directory, + extra, + filepath, interpolate, megaparsec, prettyprinter, string-qq, tasty, + tasty-golden, tasty-hunit other-modules: Language.OCaml.Parser.AndLetBinding.Test Language.OCaml.Parser.Attribute.Test Language.OCaml.Parser.Attributes.Test Language.OCaml.Parser.AttrId.Test - Language.OCaml.Parser.Common.Test Language.OCaml.Parser.Constant.Test Language.OCaml.Parser.ConstrLongident.Test + Language.OCaml.Parser.CoreType.Test + Language.OCaml.Parser.CoreType2.Test + Language.OCaml.Parser.CoreTypeNoAttr.Test Language.OCaml.Parser.Expr.Test Language.OCaml.Parser.ExtAttributes.Test Language.OCaml.Parser.Generator.Expr.Test Language.OCaml.Parser.Generator.Implementation.Test + Language.OCaml.Parser.Generator.LetBinding.Test Language.OCaml.Parser.Generator.SeqExpr.Test Language.OCaml.Parser.Generator.SimpleExpr.Test + Language.OCaml.Parser.Generator.Structure.Test Language.OCaml.Parser.Generator.ValLongident.Test + Language.OCaml.Parser.Ident.Test Language.OCaml.Parser.Implementation.Test Language.OCaml.Parser.Int.Test Language.OCaml.Parser.LetBinding.Test @@ -236,8 +153,12 @@ Language.OCaml.Parser.PostItemAttributes.Test Language.OCaml.Parser.RecFlag.Test Language.OCaml.Parser.SeqExpr.Test + Language.OCaml.Parser.SimpleCoreType.Test + Language.OCaml.Parser.SimpleCoreType2.Test + Language.OCaml.Parser.SimpleCoreTypeOrTuple.Test Language.OCaml.Parser.SimpleExpr.Test Language.OCaml.Parser.SimplePattern.Test + Language.OCaml.Parser.SimplePatternNotIdent.Test Language.OCaml.Parser.SingleAttrId.Test Language.OCaml.Parser.StrictBinding.Test Language.OCaml.Parser.Structure.Test @@ -245,7 +166,6 @@ Language.OCaml.Parser.StructureTail.Test Language.OCaml.Parser.TestStrings Language.OCaml.Parser.TestUtils - Language.OCaml.Parser.Tokens.Test Language.OCaml.Parser.ValIdent.Test Language.OCaml.Parser.ValLongident.Test Language.OCaml.PrettyPrinter.Structure.Test diff --git a/lib/Language/OCaml/Parser.hs b/lib/Language/OCaml/Parser.hs --- a/lib/Language/OCaml/Parser.hs +++ b/lib/Language/OCaml/Parser.hs @@ -1,27 +1,6 @@ module Language.OCaml.Parser - ( ParserC - , ParserG - , implementationP - , parseImplementationC - , parseImplementationG + ( Parser + , parseImplementation ) where -import Data.Void -import Text.Megaparsec (parse) -import Text.Megaparsec.Error - -import Language.OCaml.Definitions.Parsing.ParseTree --- import qualified Language.OCaml.Parser.Generator.Lexer as GL -import qualified Language.OCaml.Parser.Generator.Parser as GP -import Language.OCaml.Parser.Implementation -import Language.OCaml.Parser.Utils.Types - -type ParserC a = Parser a - -type ParserG a = GP.Parser a - -parseImplementationC :: String -> Either (ParseError Char Void) Structure -parseImplementationC = parse implementationP "Language.OCaml.Parser" - -parseImplementationG :: GP.Parser [StructureItem] -parseImplementationG = GP.parseImplementation +import Language.OCaml.Parser.Generator.Parser diff --git a/lib/Language/OCaml/Parser/AndTypeDeclaration.hs b/lib/Language/OCaml/Parser/AndTypeDeclaration.hs deleted file mode 100644 --- a/lib/Language/OCaml/Parser/AndTypeDeclaration.hs +++ /dev/null @@ -1,29 +0,0 @@ -{-# LANGUAGE DisambiguateRecordFields #-} -{-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE NamedFieldPuns #-} - -module Language.OCaml.Parser.AndTypeDeclaration - ( andTypeDeclarationP - ) where - -import Data.Default -import Text.Megaparsec - -import Language.OCaml.Definitions.Parsing.ASTHelper.Type as Type -import Language.OCaml.Definitions.Parsing.ParseTree -import Language.OCaml.Parser.Common -import Language.OCaml.Parser.Tokens -import Language.OCaml.Parser.TypeKind -import Language.OCaml.Parser.PostItemAttributes -import Language.OCaml.Parser.Utils.Types - -andTypeDeclarationP :: Parser Structure -> Parser TypeDeclaration -andTypeDeclarationP structureP = do - try $ andT - -- TODO: attributes - -- TODO: optionalTypeParameters - i <- lIdentT - (kind, priv, manifest) <- typeKindP structureP - -- TODO: constraints - attrs <- postItemAttributesP structureP -- FIXME: use me - return $ Type.mk (def { attrs, kind, priv }) manifest (mkRHS i 4) -- FIXME: [] and [] diff --git a/lib/Language/OCaml/Parser/AttrId.hs b/lib/Language/OCaml/Parser/AttrId.hs deleted file mode 100644 --- a/lib/Language/OCaml/Parser/AttrId.hs +++ /dev/null @@ -1,21 +0,0 @@ -module Language.OCaml.Parser.AttrId - ( attrIdP - ) where - -import Text.Megaparsec - -import qualified Language.OCaml.Definitions.Parsing.ASTTypes as ASTTypes -import Language.OCaml.Definitions.Parsing.ParseTree -import Language.OCaml.Parser.Common -import Language.OCaml.Parser.SingleAttrId -import Language.OCaml.Parser.Tokens -import Language.OCaml.Parser.Utils.Types - -attrIdP :: Parser (ASTTypes.Loc String) -attrIdP = choice - [ do - a <- try $ singleAttrIdP <* dotT - b <- attrIdP - return $ mkLoc (a ++ "^" ++ ASTTypes.txt b) none -- FIXME symbolRLoc - , singleAttrIdP >>= \ a -> return $ mkLoc a none -- FIXME symbolRLoc - ] diff --git a/lib/Language/OCaml/Parser/Attribute.hs b/lib/Language/OCaml/Parser/Attribute.hs deleted file mode 100644 --- a/lib/Language/OCaml/Parser/Attribute.hs +++ /dev/null @@ -1,21 +0,0 @@ -module Language.OCaml.Parser.Attribute - ( attributeP - ) where - -import Text.Megaparsec - -import qualified Language.OCaml.Definitions.Parsing.ASTTypes as ASTTypes -import Language.OCaml.Definitions.Parsing.ParseTree -import Language.OCaml.Parser.AttrId -import Language.OCaml.Parser.Payload -import Language.OCaml.Parser.Tokens -import Language.OCaml.Parser.Utils.Types - -attributeP :: Parser Structure -> Parser (ASTTypes.Loc String, Payload) -attributeP structureP = do - i <- try $ do - lBracketAtT - attrIdP - p <- payloadP structureP - rBracketT - return (i, p) diff --git a/lib/Language/OCaml/Parser/Attributes.hs b/lib/Language/OCaml/Parser/Attributes.hs deleted file mode 100644 --- a/lib/Language/OCaml/Parser/Attributes.hs +++ /dev/null @@ -1,13 +0,0 @@ -module Language.OCaml.Parser.Attributes - ( attributesP - ) where - -import Text.Megaparsec - -import Language.OCaml.Definitions.Parsing.ASTTypes -import Language.OCaml.Definitions.Parsing.ParseTree -import Language.OCaml.Parser.Attribute -import Language.OCaml.Parser.Utils.Types - -attributesP :: Parser Structure -> Parser [(Loc String, Payload)] -attributesP structureP = many (attributeP structureP) diff --git a/lib/Language/OCaml/Parser/BarConstructorDeclaration.hs b/lib/Language/OCaml/Parser/BarConstructorDeclaration.hs deleted file mode 100644 --- a/lib/Language/OCaml/Parser/BarConstructorDeclaration.hs +++ /dev/null @@ -1,27 +0,0 @@ -{-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE NamedFieldPuns #-} - -module Language.OCaml.Parser.BarConstructorDeclaration - ( barConstructorDeclarationP - ) where - -import Data.Default -import Text.Megaparsec - -import Language.OCaml.Definitions.Parsing.ASTHelper.Type as Type -import Language.OCaml.Definitions.Parsing.ParseTree -import Language.OCaml.Parser.Attributes -import Language.OCaml.Parser.Common -import Language.OCaml.Parser.ConstrIdent -import Language.OCaml.Parser.GeneralizedConstructorArguments -import Language.OCaml.Parser.Tokens -import Language.OCaml.Parser.Utils.Types - -barConstructorDeclarationP :: - Parser Structure -> Parser CoreType -> Parser ConstructorDeclaration -barConstructorDeclarationP structureP coreTypeP = try $ do - barT - i <- constrIdentP - (args, res) <- generalizedConstructorArgumentsP coreTypeP - attrs <- attributesP structureP - return $ Type.constructor (def { args, attrs }) res (mkRHS i (2 :: Int)) diff --git a/lib/Language/OCaml/Parser/Common.hs b/lib/Language/OCaml/Parser/Common.hs --- a/lib/Language/OCaml/Parser/Common.hs +++ b/lib/Language/OCaml/Parser/Common.hs @@ -14,7 +14,6 @@ , ghexp , ghtyp , ghpat - , identP , mkexp , mkexpAttrs , mkexpCons @@ -58,7 +57,6 @@ import Data.Default import Data.Maybe import Prelude hiding (exp) -import Text.Megaparsec import Language.OCaml.Definitions.Parsing.ASTHelper.Exp as Exp hiding (newType) import Language.OCaml.Definitions.Parsing.ASTHelper.Mod as Mod @@ -75,12 +73,6 @@ import Language.OCaml.Definitions.Parsing.ParseTree import Language.OCaml.Definitions.Parsing.Parser.LetBinding import Language.OCaml.Definitions.Parsing.Parser.LetBindings -import Language.OCaml.Parser.Tokens -import Language.OCaml.Parser.Utils.Utils -import Language.OCaml.Parser.Utils.Types - -identP :: Parser String -identP = lexeme $ choice [ uIdentT, lIdentT ] mkstr :: StructureItemDesc -> StructureItem mkstr d = Str.mk def d -- FIXME: symbolRLoc diff --git a/lib/Language/OCaml/Parser/Constant.hs b/lib/Language/OCaml/Parser/Constant.hs deleted file mode 100644 --- a/lib/Language/OCaml/Parser/Constant.hs +++ /dev/null @@ -1,23 +0,0 @@ -module Language.OCaml.Parser.Constant - ( constantP - ) where - -import Text.Megaparsec - -import Language.OCaml.Definitions.Parsing.ParseTree -import Language.OCaml.Parser.Tokens -import Language.OCaml.Parser.Utils.Types - -constantP :: Parser Constant -constantP = choice - [ do - (n, m) <- intT - return $ PconstInteger n m - , PconstChar <$> charT - , do - (s, d) <- stringT - return $ PconstString s d - -- , do - -- (f, m) <- stringT - -- return $ PconstFloat f m - ] diff --git a/lib/Language/OCaml/Parser/ConstrIdent.hs b/lib/Language/OCaml/Parser/ConstrIdent.hs deleted file mode 100644 --- a/lib/Language/OCaml/Parser/ConstrIdent.hs +++ /dev/null @@ -1,18 +0,0 @@ -module Language.OCaml.Parser.ConstrIdent - ( constrIdentP - ) where - -import Text.Megaparsec - -import Language.OCaml.Parser.Tokens -import Language.OCaml.Parser.Utils.Types - -constrIdentP :: Parser String -constrIdentP = choice - [ uIdentT - , lBracketT *> rBracketT *> return "[]" - , lParenT *> rParenT *> return "()" - , lParenT *> colonColonT *> rParenT *> return "::" - , falseT *> return "false" - , trueT *> return "true" - ] diff --git a/lib/Language/OCaml/Parser/ConstrLongident.hs b/lib/Language/OCaml/Parser/ConstrLongident.hs deleted file mode 100644 --- a/lib/Language/OCaml/Parser/ConstrLongident.hs +++ /dev/null @@ -1,28 +0,0 @@ -module Language.OCaml.Parser.ConstrLongident - ( constrLongidentP - ) where - -import Text.Megaparsec - -import Language.OCaml.Definitions.Parsing.ParseTree -import Language.OCaml.Parser.ModLongident -import Language.OCaml.Parser.Tokens -import Language.OCaml.Parser.Utils.Types -import Language.OCaml.Parser.Utils.Utils - -constrLongidentP :: Parser Longident -constrLongidentP = choice - [ do - i <- try $ do - i <- modLongidentP - dotT - return i - parens colonColonT - return $ Ldot i "::" - , modLongidentP - , try $ lBracketT *> rBracketT *> (return $ Lident "[]") - , try $ lParenT *> rParenT *> (return $ Lident "()") - , try (lParenT *> colonColonT) *> rParenT *> (return $ Lident "::") - , falseT *> (return $ Lident "false") - , trueT *> (return $ Lident "true") - ] diff --git a/lib/Language/OCaml/Parser/ConstructorArguments.hs b/lib/Language/OCaml/Parser/ConstructorArguments.hs deleted file mode 100644 --- a/lib/Language/OCaml/Parser/ConstructorArguments.hs +++ /dev/null @@ -1,15 +0,0 @@ -module Language.OCaml.Parser.ConstructorArguments - ( constructorArgumentsP - ) where - -import Text.Megaparsec - -import Language.OCaml.Definitions.Parsing.ParseTree -import Language.OCaml.Parser.CoreTypeList -import Language.OCaml.Parser.Utils.Types - -constructorArgumentsP :: Parser CoreType -> Parser ConstructorArguments -constructorArgumentsP coreTypeP = choice - [ PcstrTuple . reverse <$> coreTypelistP coreTypeP - -- TODO: label declarations - ] diff --git a/lib/Language/OCaml/Parser/ConstructorDeclaration.hs b/lib/Language/OCaml/Parser/ConstructorDeclaration.hs deleted file mode 100644 --- a/lib/Language/OCaml/Parser/ConstructorDeclaration.hs +++ /dev/null @@ -1,25 +0,0 @@ -{-# LANGUAGE DisambiguateRecordFields #-} -{-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE NamedFieldPuns #-} - -module Language.OCaml.Parser.ConstructorDeclaration - ( constructorDeclarationP - ) where - -import Data.Default - -import Language.OCaml.Definitions.Parsing.ASTHelper.Type as Type -import Language.OCaml.Definitions.Parsing.ParseTree -import Language.OCaml.Parser.Attributes -import Language.OCaml.Parser.Common -import Language.OCaml.Parser.ConstrIdent -import Language.OCaml.Parser.GeneralizedConstructorArguments -import Language.OCaml.Parser.Utils.Types - -constructorDeclarationP :: - Parser Structure -> Parser CoreType -> Parser ConstructorDeclaration -constructorDeclarationP structureP coreTypeP = do - name <- constrIdentP - (args, res) <- generalizedConstructorArgumentsP coreTypeP - attrs <- attributesP structureP - return $ Type.constructor (def { args, attrs }) res (mkRHS name (1 :: Int)) diff --git a/lib/Language/OCaml/Parser/ConstructorDeclarations.hs b/lib/Language/OCaml/Parser/ConstructorDeclarations.hs deleted file mode 100644 --- a/lib/Language/OCaml/Parser/ConstructorDeclarations.hs +++ /dev/null @@ -1,23 +0,0 @@ -module Language.OCaml.Parser.ConstructorDeclarations - ( constructorDeclarationsP - ) where - -import Language.OCaml.Definitions.Parsing.ParseTree -import Language.OCaml.Parser.BarConstructorDeclaration -import Language.OCaml.Parser.ConstructorDeclaration -import Language.OCaml.Parser.Tokens -import Language.OCaml.Parser.Utils.Combinators -import Language.OCaml.Parser.Utils.Types - -constructorDeclarationsP :: - Parser Structure -> Parser CoreType -> Parser [ConstructorDeclaration] -constructorDeclarationsP structureP coreTypeP = leftRecursive - [ (: []) <$> constructorDeclarationP' - , (: []) <$> barConstructorDeclarationP' - , barT *> return [] - ] - [ (:) <$> barConstructorDeclarationP' - ] - where - constructorDeclarationP' = constructorDeclarationP structureP coreTypeP - barConstructorDeclarationP' = barConstructorDeclarationP structureP coreTypeP diff --git a/lib/Language/OCaml/Parser/CoreType.hs b/lib/Language/OCaml/Parser/CoreType.hs deleted file mode 100644 --- a/lib/Language/OCaml/Parser/CoreType.hs +++ /dev/null @@ -1,18 +0,0 @@ -module Language.OCaml.Parser.CoreType - ( coreTypeP - ) where - -import Text.Megaparsec - -import Language.OCaml.Definitions.Parsing.ParseTree -import Language.OCaml.Parser.CoreTypeNoAttr -import Language.OCaml.Parser.Utils.Types - -coreTypeP :: Parser CoreType -coreTypeP = choice - [ coreTypenoAttrP coreTypeP - -- , do - -- t <- coreType - -- a <- attribute - -- return $ attr t a - ] diff --git a/lib/Language/OCaml/Parser/CoreType2.hs b/lib/Language/OCaml/Parser/CoreType2.hs deleted file mode 100644 --- a/lib/Language/OCaml/Parser/CoreType2.hs +++ /dev/null @@ -1,26 +0,0 @@ -module Language.OCaml.Parser.CoreType2 - ( coreType2P - ) where - -import Language.OCaml.Definitions.Parsing.ASTTypes -import Language.OCaml.Definitions.Parsing.ParseTree -import Language.OCaml.Parser.SimpleCoreTypeOrTuple -import Language.OCaml.Parser.Common -import Language.OCaml.Parser.Tokens -import Language.OCaml.Parser.Utils.Combinators -import Language.OCaml.Parser.Utils.Types - -coreType2P :: Parser CoreType -> Parser CoreType -coreType2P coreTypeP = leftRecursive - [ simpleCoreTypeOrTupleP coreTypeP - -- TODO - ] - [ do - minusGreaterT - t2 <- coreType2P' - return $ \ t1 -> - let param = extraRHSCoreType t1 (1 :: Int) in - mktyp $ PtypArrow Nolabel param t2 - ] - where - coreType2P' = coreType2P coreTypeP diff --git a/lib/Language/OCaml/Parser/CoreTypeCommaList.hs b/lib/Language/OCaml/Parser/CoreTypeCommaList.hs deleted file mode 100644 --- a/lib/Language/OCaml/Parser/CoreTypeCommaList.hs +++ /dev/null @@ -1,12 +0,0 @@ -module Language.OCaml.Parser.CoreTypeCommaList - ( coreTypeCommaListP - ) where - -import Text.Megaparsec - -import Language.OCaml.Definitions.Parsing.ParseTree -import Language.OCaml.Parser.Tokens -import Language.OCaml.Parser.Utils.Types - -coreTypeCommaListP :: Parser CoreType -> Parser [CoreType] -coreTypeCommaListP coreTypeP = sepBy coreTypeP commaT diff --git a/lib/Language/OCaml/Parser/CoreTypeList.hs b/lib/Language/OCaml/Parser/CoreTypeList.hs deleted file mode 100644 --- a/lib/Language/OCaml/Parser/CoreTypeList.hs +++ /dev/null @@ -1,21 +0,0 @@ -module Language.OCaml.Parser.CoreTypeList - ( coreTypelistP - ) where - -import Text.Megaparsec - -import Language.OCaml.Definitions.Parsing.ParseTree -import Language.OCaml.Parser.SimpleCoreType -import Language.OCaml.Parser.Tokens -import Language.OCaml.Parser.Utils.Combinators -import Language.OCaml.Parser.Utils.Types - -coreTypelistP :: Parser CoreType -> Parser [CoreType] -coreTypelistP coreTypeP = leftRecursive - [ (: []) <$> simpleCoreTypeP coreTypeP - ] - [ do - try $ starT - t <- simpleCoreTypeP coreTypeP - return $ (:) t - ] diff --git a/lib/Language/OCaml/Parser/CoreTypeNoAttr.hs b/lib/Language/OCaml/Parser/CoreTypeNoAttr.hs deleted file mode 100644 --- a/lib/Language/OCaml/Parser/CoreTypeNoAttr.hs +++ /dev/null @@ -1,15 +0,0 @@ -module Language.OCaml.Parser.CoreTypeNoAttr - ( coreTypenoAttrP - ) where - -import Text.Megaparsec - -import Language.OCaml.Definitions.Parsing.ParseTree -import Language.OCaml.Parser.CoreType2 -import Language.OCaml.Parser.Utils.Types - -coreTypenoAttrP :: Parser CoreType -> Parser CoreType -coreTypenoAttrP coreTypeP = choice - [ coreType2P coreTypeP - -- , TODO - ] diff --git a/lib/Language/OCaml/Parser/Expr.hs b/lib/Language/OCaml/Parser/Expr.hs deleted file mode 100644 --- a/lib/Language/OCaml/Parser/Expr.hs +++ /dev/null @@ -1,99 +0,0 @@ -module Language.OCaml.Parser.Expr - ( exprP - ) where - -import Text.Megaparsec hiding (token) - -import Language.OCaml.Definitions.Parsing.ParseTree -import Language.OCaml.Parser.Common -import Language.OCaml.Parser.FunDef -import Language.OCaml.Parser.LabeledSimplePattern -import Language.OCaml.Parser.LetBindings -import Language.OCaml.Parser.MatchCases -import Language.OCaml.Parser.OptBar -import Language.OCaml.Parser.Pattern -import Language.OCaml.Parser.SimpleLabeledExprList -import Language.OCaml.Parser.SimpleExpr -import Language.OCaml.Parser.Tokens -import Language.OCaml.Parser.Utils.Combinators -import Language.OCaml.Parser.Utils.Types -import Language.OCaml.PrettyPrinter () - -exprP :: Parser Structure -> Parser Expression -> Parser Expression -exprP structureP seqExprP = choice - [ try $ parser <* notFollowedBy commaT - , mkexp . PexpTuple . reverse <$> - chainl1' parser (commaT *> (return $ flip (:))) (: []) - ] - where - parser = leftRecursive - [ try $ do - e <- simpleExprP' - l <- simpleLabeledExprListP' - return $ mkexp $ PexpApply e (reverse l) - , do - b <- try $ do - b <- letBindingsP structureP seqExprP - inT - return b - e <- seqExprP - return $ exprOfLetBindings b e - -- FUNCTION - , do - try $ functionT - -- TODO: extAttributes - optBarP - l <- matchCasesP' - return $ mkexpAttrs (PexpFunction $ reverse l) (Nothing, []) -- FIXME - -- FUN - , do - try $ funT - -- TODO: extAttributes - (l, o, p) <- labeledSimplePatternP patternP - d <- funDefP seqExprP - return $ mkexpAttrs (PexpFun l o p d) (Nothing, []) -- FIXME - -- MATCH - , do - try $ matchT - -- TODO: extAttributes - e <- seqExprP - withT - optBarP - l <- matchCasesP' - return $ mkexpAttrs (PexpMatch e $ reverse l) (Nothing, []) -- FIXME - -- IF ... THEN ... ELSE ... - , do - try ifT - -- TODO: extAttributes - c <- seqExprP - thenT - t <- exprP' - e <- choice - [ do - try elseT - Just <$> exprP' - , return Nothing - ] - return $ mkexpAttrs (PexpIfThenElse c t e) (Nothing, []) -- FIXME - , simpleExprP' - ] - -- FIXME: deal with associativity? - [ infixP equalT "=" - , infixP plusT "+" - , infixP minusT "-" - , infixP starT "*" - , infixP caretT "^" - , infixP greaterT ">" - , infixP atT "@" - ] - - infixP :: Parser () -> String -> Parser (Expression -> Expression) - infixP token symbol = try $ do - token - e2 <- exprP' - return $ \ e1 -> mkinfix e1 symbol e2 - - exprP' = exprP structureP seqExprP - simpleExprP' = simpleExprP seqExprP exprP' - simpleLabeledExprListP' = simpleLabeledExprListP seqExprP exprP' - matchCasesP' = matchCasesP seqExprP diff --git a/lib/Language/OCaml/Parser/ExprSemiList.hs b/lib/Language/OCaml/Parser/ExprSemiList.hs deleted file mode 100644 --- a/lib/Language/OCaml/Parser/ExprSemiList.hs +++ /dev/null @@ -1,18 +0,0 @@ -module Language.OCaml.Parser.ExprSemiList - ( exprSemiListP - ) where - -import Language.OCaml.Definitions.Parsing.ParseTree -import Language.OCaml.Parser.Tokens -import Language.OCaml.Parser.Utils.Combinators -import Language.OCaml.Parser.Utils.Types - -exprSemiListP :: Parser Expression -> Parser [Expression] -exprSemiListP exprP = leftRecursive - [ (: []) <$> exprP - ] - [ do - semiT - e2 <- exprP - return $ \ e1 -> e2 : e1 - ] diff --git a/lib/Language/OCaml/Parser/FunBinding.hs b/lib/Language/OCaml/Parser/FunBinding.hs deleted file mode 100644 --- a/lib/Language/OCaml/Parser/FunBinding.hs +++ /dev/null @@ -1,22 +0,0 @@ -module Language.OCaml.Parser.FunBinding - ( funBindingP - ) where - -import Text.Megaparsec - -import Language.OCaml.Definitions.Parsing.ParseTree -import Language.OCaml.Parser.Common -import Language.OCaml.Parser.TypeConstraint -import Language.OCaml.Parser.StrictBinding -import Language.OCaml.Parser.Tokens -import Language.OCaml.Parser.Utils.Types - -funBindingP :: Parser Expression -> Parser Expression -funBindingP seqExprP = choice - [ strictBindingP seqExprP (funBindingP seqExprP) - , do - c <- typeConstraintP - equalT - e <- seqExprP - return $ mkexpConstraint e c - ] diff --git a/lib/Language/OCaml/Parser/FunDef.hs b/lib/Language/OCaml/Parser/FunDef.hs deleted file mode 100644 --- a/lib/Language/OCaml/Parser/FunDef.hs +++ /dev/null @@ -1,27 +0,0 @@ -module Language.OCaml.Parser.FunDef - ( funDefP - ) where - -import Text.Megaparsec - -import Language.OCaml.Definitions.Parsing.ParseTree -import Language.OCaml.Parser.Common -import Language.OCaml.Parser.LabeledSimplePattern -import Language.OCaml.Parser.Pattern -import Language.OCaml.Parser.Tokens -import Language.OCaml.Parser.Utils.Types -import Language.OCaml.PrettyPrinter () - -funDefP :: Parser Expression -> Parser Expression -funDefP seqExprP = choice - [ do - minusGreaterT - seqExprP - -- TODO - , do - (l, o, p) <- labeledSimplePatternP patternP - d <- funDefP' - return $ ghexp $ PexpFun l o p d - ] - where - funDefP' = funDefP seqExprP diff --git a/lib/Language/OCaml/Parser/GeneralizedConstructorArguments.hs b/lib/Language/OCaml/Parser/GeneralizedConstructorArguments.hs deleted file mode 100644 --- a/lib/Language/OCaml/Parser/GeneralizedConstructorArguments.hs +++ /dev/null @@ -1,17 +0,0 @@ -module Language.OCaml.Parser.GeneralizedConstructorArguments - ( generalizedConstructorArgumentsP - ) where - -import Text.Megaparsec - -import Language.OCaml.Definitions.Parsing.ParseTree -import Language.OCaml.Parser.ConstructorArguments -import Language.OCaml.Parser.Tokens -import Language.OCaml.Parser.Utils.Types - -generalizedConstructorArgumentsP :: Parser CoreType -> Parser (ConstructorArguments, Maybe a) -generalizedConstructorArgumentsP coreTypeP = choice - [ flip (,) Nothing <$> (ofT *> constructorArgumentsP coreTypeP) - -- TODO: colon - , return (PcstrTuple [], Nothing) - ] diff --git a/lib/Language/OCaml/Parser/Generator/Lexer.x b/lib/Language/OCaml/Parser/Generator/Lexer.x --- a/lib/Language/OCaml/Parser/Generator/Lexer.x +++ b/lib/Language/OCaml/Parser/Generator/Lexer.x @@ -40,7 +40,7 @@ $blank = [\ \t \f] $identChar = [A-Z a-z _ '\'' 0-9] $lowerCase = [a-z _] -$symbolChar = [!]-- '$' '%']-- '&' '*' '+' '-' '.' ] -- '/' ':' '<' '=' '>' '?' '@' '^' '|' '~'] +$symbolChar = [\! \$ \% \& \* \+ \- \. \/ \: \< \= \> \? \@ \^ \| \~] $upperCase = [A-Z] -- Regular expression macros @@ -143,8 +143,16 @@ <0> "-" { tok TokMinus } <0> "-." { tok TokMinusDot } <0> "!" $symbolChar+ { tokS TokPrefixOp } + <0> [\~ \?] $symbolChar+ { tokS TokPrefixOp } + <0> [\= \< \> \| \& \$] $symbolChar+ { tokS TokInfixOp0 } + <0> [\@ \^] $symbolChar* { tokS TokInfixOp1 } + <0> [\+ \-] $symbolChar* { tokS TokInfixOp2 } + <0> "**" $symbolChar* { tokS TokInfixOp4 } + <0> "%" { tok TokPercent } + <0> [\* \/ \%] $symbolChar* { tokS TokInfixOp3 } + -- <0> '#' (symbolchar | '#') + { HASHOP op } -- TODO - <0> [= \< > \| & \$] $symbolChar* { tokS TokInfixOp0 } + <0> [\= \< \> \| \& \$] $symbolChar* { tokS TokInfixOp0 } -- while inside a string \" { endString } @@ -540,6 +548,7 @@ commentString <- getStringBuffer let (endLine, endCol) = getMyPosition alexInput let ss = SrcSpan startLine startCol endLine endCol + alexSetStartCode codeStartCode return $ Just $ Located ss $ TokComment commentString _ -> do popCommentStartLoc diff --git a/lib/Language/OCaml/Parser/Generator/Parser.y b/lib/Language/OCaml/Parser/Generator/Parser.y --- a/lib/Language/OCaml/Parser/Generator/Parser.y +++ b/lib/Language/OCaml/Parser/Generator/Parser.y @@ -10,11 +10,13 @@ , parseExpr , parseExprCommaList , parseImplementation + , parseLetBinding , parseModLongident , parseOpenStatement , parsePattern , parseSeqExpr , parseSimpleExpr + , parseSimplePattern , parseStructure , parseStructureItem , parseValIdent @@ -51,11 +53,13 @@ %name rawParseExpr Expr %name rawParseExprCommaList ExprCommaList %name rawParseImplementation Implementation +%name rawParseLetBinding LetBinding %name rawParseModLongident ModLongident %name rawParseOpenStatement OpenStatement %name rawParsePattern Pattern %name rawParseSeqExpr SeqExpr %name rawParseSimpleExpr SimpleExpr +%name rawParseSimplePattern SimplePattern %name rawParseStructureItem StructureItem %name rawParseStructure Structure %name rawParseValIdent ValIdent @@ -227,6 +231,10 @@ %% +Additive :: { String } + : "+" { "+" } + | "+." { "+." } + AmperTypeList :: { [CoreType] } : CoreTypeNoAttr { [$1] } | AmperTypeList "&" CoreTypeNoAttr { $3 : $1 } @@ -378,6 +386,11 @@ "=" SeqExpr DirectionFlag SeqExpr do SeqExpr done { mkexpAttrs (PexpFor $3 $5 $7 $6 $9) $2 } | Expr "::" Expr { mkexpCons (rhsLoc 2) (ghexp $ PexpTuple [$1, $3]) (symbolRLoc ()) } + | Expr INFIXOP0 Expr { mkinfix $1 $2 $3 } + | Expr INFIXOP1 Expr { mkinfix $1 $2 $3 } + | Expr INFIXOP2 Expr { mkinfix $1 $2 $3 } + | Expr INFIXOP3 Expr { mkinfix $1 $2 $3 } + | Expr INFIXOP4 Expr { mkinfix $1 $2 $3 } -- TODO: infixops | Expr "+" Expr { mkinfix $1 "+" $3 } | Expr "+." Expr { mkinfix $1 "+." $3 } @@ -394,8 +407,11 @@ | Expr "&" Expr { mkinfix $1 "&" $3 } | Expr "&&" Expr { mkinfix $1 "&&" $3 } | Expr ":=" Expr { mkinfix $1 ":=" $3 } - -- TODO + | Subtractive Expr %prec precUnaryMinus { mkuminus $1 $2 } + | Additive Expr %prec precUnaryPlus { mkuplus $1 $2 } | SimpleExpr "." LabelLongident "<-" Expr { mkexp $ PexpSetField $1 (mkRHS $3 3) $5 } + -- TODO: label LESSMINUS expr + | assert ExtAttributes SimpleExpr %prec belowHash { mkexpAttrs (PexpAssert $3) $2 } -- TODO -- | Expr Attribute { attrExp $1 $2 } | "_" {% alexError "Wildcard not expected" } @@ -874,6 +890,14 @@ : SimpleExpr with LblExprList { (Just $1, $3) } | LblExprList { (Nothing, $1) } +RowField :: { a } + : TagField { $1 } + | SimpleCoreType { Rinherit $1 } + +RowFieldList :: { [a] } + : RowField { [$1] } + | RowFieldList "|" RowField { $3 : $1 } + SeqExpr :: { Expression } : Expr %prec belowSemi { $1 } | Expr ";" { $1 } @@ -935,6 +959,7 @@ | "(" CoreTypeCommaList ")" "#" ClassLongident { mktyp $ PtypClass (mkRHS $5 5) (reverse $2) } | "[" TagField "]" { mktyp $ PtypVariant [$2] Closed Nothing } -- TODO + | "[" "|" RowFieldList "]" { mktyp $ PtypVariant (reverse $3) Closed Nothing } | "[>" "]" { mktyp $ PtypVariant [] Open Nothing } SimpleCoreTypeOrTuple :: { CoreType } @@ -1094,9 +1119,13 @@ StructureTail :: { Structure } : {- empty -} { [] } - | "::" Structure { (textStr 1) ++ $2 } + | ";;" Structure { (textStr 1) ++ $2 } | StructureItem StructureTail { (textStr 1) ++ $1 : $2 } +Subtractive :: { String } + : "-" { "-" } + | "-." { "-." } + TagField :: { RowField } : NameTag of OptAmpersand AmperTypeList Attributes { Rtag (mkRHS $1 1) (addInfoAttrs (symbolInfo ()) $5) $3 (reverse $4) } -- TODO @@ -1162,7 +1191,7 @@ ValIdent :: { String } : LIDENT { $1 } - | "(" Operator ")" { error "TODO ValIdent" } + | "(" Operator ")" { $2 } -- TODO ValLongident :: { Longident } @@ -1199,6 +1228,9 @@ parseImplementation :: Parser [StructureItem] parseImplementation = myParse rawParseImplementation +parseLetBinding :: Parser LetBindings +parseLetBinding = myParse rawParseLetBinding + parseModLongident :: Parser Longident parseModLongident = myParse rawParseModLongident @@ -1214,6 +1246,9 @@ parseSimpleExpr :: Parser Expression parseSimpleExpr = myParse rawParseSimpleExpr +parseSimplePattern :: Parser Pattern +parseSimplePattern = myParse rawParseSimplePattern + parseStructure :: Parser Structure parseStructure = myParse rawParseStructure @@ -1228,5 +1263,28 @@ myParse :: Alex a -> String -> Either String a myParse = flip runAlex + +negString :: String -> String +negString f = + if length f > 0 && f !! 0 == '-' + then tail f + else '-' : f + +mkuminus :: String -> Expression -> Expression +mkuminus name arg = + case (name, pexpDesc arg) of + ("-", PexpConstant (PconstInteger n m)) -> mkexp $ PexpConstant $ PconstInteger (negString n) m + ("-", PexpConstant (PconstFloat f m)) -> mkexp $ PexpConstant $ PconstFloat (negString f) m + ("-.", PexpConstant (PconstFloat f m)) -> mkexp $ PexpConstant $ PconstFloat (negString f) m + _ -> mkexp $ PexpApply (mkOperator ("~" ++ name) 1) [(Nolabel, arg)] + +mkuplus :: String -> Expression -> Expression +mkuplus name arg = + let desc = pexpDesc arg in + case (name, desc) of + ("+", PexpConstant (PconstInteger _ _)) -> mkexp desc + ("+", PexpConstant (PconstFloat _ _)) -> mkexp desc + ("+.", PexpConstant (PconstFloat _ _)) -> mkexp desc + _ -> mkexp $ PexpApply (mkOperator ("~" ++ name) 1) [(Nolabel, arg)] } diff --git a/lib/Language/OCaml/Parser/Implementation.hs b/lib/Language/OCaml/Parser/Implementation.hs deleted file mode 100644 --- a/lib/Language/OCaml/Parser/Implementation.hs +++ /dev/null @@ -1,13 +0,0 @@ -module Language.OCaml.Parser.Implementation - ( implementationP - ) where - -import Text.Megaparsec - -import Language.OCaml.Definitions.Parsing.ParseTree -import Language.OCaml.Parser.Structure -import Language.OCaml.Parser.Utils.Utils -import Language.OCaml.Parser.Utils.Types - -implementationP :: Parser Structure -implementationP = ocamlSpace *> structureP <* eof diff --git a/lib/Language/OCaml/Parser/Internal.hs b/lib/Language/OCaml/Parser/Internal.hs deleted file mode 100644 --- a/lib/Language/OCaml/Parser/Internal.hs +++ /dev/null @@ -1,200 +0,0 @@ -module Language.OCaml.Parser.Internal - ( module Language.OCaml.Parser.Tokens - , Parser - , attributeP - , attributesP - , barConstructorDeclarationP - , constantP - , constrIdentP - , constrLongidentP - , constructorArgumentsP - , constructorDeclarationP - , constructorDeclarationsP - , coreTypeP - , coreType2P - , coreTypeCommaListP - , coreTypelistP - , exprP - , generalizedConstructorArgumentsP - , identP - , implementationP - , labeledSimpleExprP - , lblExprP - , lblExprListP - , letBindingP - , letBindingBodyP - , matchCaseP - , modLongidentP - , openStatementP - , patternP - , patternNoExnP - , postItemAttributesP - , recordExprP - , seqExprP - , simpleCoreTypeP - , simpleCoreType2P - , simpleCoreTypeOrTupleP - , simpleExprP - , simpleLabeledExprListP - , simplePatternP - , structureP - , structureItemP - , typeDeclarationP - , typeDeclarationsP - , typeKindP - , valIdentP - , valLongidentP - ) where - -import Language.OCaml.Definitions.Parsing.ASTTypes -import Language.OCaml.Definitions.Parsing.Parser.LetBindings -import Language.OCaml.Definitions.Parsing.ParseTree -import qualified Language.OCaml.Parser.Attribute -import qualified Language.OCaml.Parser.Attributes -import qualified Language.OCaml.Parser.BarConstructorDeclaration -import Language.OCaml.Parser.Common -import Language.OCaml.Parser.Constant -import Language.OCaml.Parser.ConstrIdent -import Language.OCaml.Parser.ConstrLongident -import qualified Language.OCaml.Parser.ConstructorArguments -import qualified Language.OCaml.Parser.ConstructorDeclaration -import qualified Language.OCaml.Parser.ConstructorDeclarations -import Language.OCaml.Parser.CoreType -import qualified Language.OCaml.Parser.CoreType2 -import qualified Language.OCaml.Parser.CoreTypeCommaList -import qualified Language.OCaml.Parser.CoreTypeList -import qualified Language.OCaml.Parser.Expr -import qualified Language.OCaml.Parser.GeneralizedConstructorArguments -import Language.OCaml.Parser.Implementation -import qualified Language.OCaml.Parser.LabeledSimpleExpr -import qualified Language.OCaml.Parser.LblExpr -import qualified Language.OCaml.Parser.LblExprList -import qualified Language.OCaml.Parser.LetBinding -import qualified Language.OCaml.Parser.LetBindingBody -import qualified Language.OCaml.Parser.MatchCase -import Language.OCaml.Parser.ModLongident -import Language.OCaml.Parser.OpenStatement -import Language.OCaml.Parser.Pattern -import Language.OCaml.Parser.PatternNoExn -import qualified Language.OCaml.Parser.PostItemAttributes -import qualified Language.OCaml.Parser.RecordExpr -import qualified Language.OCaml.Parser.SeqExpr -import qualified Language.OCaml.Parser.SimpleCoreType -import qualified Language.OCaml.Parser.SimpleCoreType2 -import qualified Language.OCaml.Parser.SimpleCoreTypeOrTuple -import qualified Language.OCaml.Parser.SimpleExpr -import qualified Language.OCaml.Parser.SimpleLabeledExprList -import qualified Language.OCaml.Parser.SimplePattern -import Language.OCaml.Parser.Structure -import qualified Language.OCaml.Parser.StructureItem -import Language.OCaml.Parser.Tokens -import qualified Language.OCaml.Parser.TypeDeclaration -import qualified Language.OCaml.Parser.TypeDeclarations -import qualified Language.OCaml.Parser.TypeKind -import Language.OCaml.Parser.ValIdent -import Language.OCaml.Parser.ValLongident -import Language.OCaml.Parser.Utils.Types - --- Tying the knots for our clients! - -attributeP :: Parser (Loc String, Payload) -attributeP = Language.OCaml.Parser.Attribute.attributeP structureP - -attributesP :: Parser [(Loc String, Payload)] -attributesP = Language.OCaml.Parser.Attributes.attributesP structureP - -barConstructorDeclarationP :: Parser ConstructorDeclaration -barConstructorDeclarationP = - Language.OCaml.Parser.BarConstructorDeclaration.barConstructorDeclarationP structureP coreTypeP - -constructorArgumentsP :: Parser ConstructorArguments -constructorArgumentsP = - Language.OCaml.Parser.ConstructorArguments.constructorArgumentsP coreTypeP - -constructorDeclarationP :: Parser ConstructorDeclaration -constructorDeclarationP = - Language.OCaml.Parser.ConstructorDeclaration.constructorDeclarationP structureP coreTypeP - -constructorDeclarationsP :: Parser [ConstructorDeclaration] -constructorDeclarationsP = - Language.OCaml.Parser.ConstructorDeclarations.constructorDeclarationsP structureP coreTypeP - -coreType2P :: Parser CoreType -coreType2P = Language.OCaml.Parser.CoreType2.coreType2P coreTypeP - -coreTypeCommaListP :: Parser [CoreType] -coreTypeCommaListP = - Language.OCaml.Parser.CoreTypeCommaList.coreTypeCommaListP coreTypeP - -coreTypelistP :: Parser [CoreType] -coreTypelistP = Language.OCaml.Parser.CoreTypeList.coreTypelistP coreTypeP - -exprP :: Parser Expression -exprP = Language.OCaml.Parser.Expr.exprP structureP seqExprP - -generalizedConstructorArgumentsP :: Parser (ConstructorArguments, Maybe a) -generalizedConstructorArgumentsP = - Language.OCaml.Parser.GeneralizedConstructorArguments.generalizedConstructorArgumentsP - coreTypeP - -lblExprP :: Parser (Loc Longident, Expression) -lblExprP = Language.OCaml.Parser.LblExpr.lblExprP exprP - -lblExprListP :: Parser [(Loc Longident, Expression)] -lblExprListP = Language.OCaml.Parser.LblExprList.lblExprListP exprP - -labeledSimpleExprP :: Parser (ArgLabel, Expression) -labeledSimpleExprP = - Language.OCaml.Parser.LabeledSimpleExpr.labeledSimpleExprP seqExprP exprP - -letBindingP :: Parser LetBindings -letBindingP = - Language.OCaml.Parser.LetBinding.letBindingP structureP seqExprP - -letBindingBodyP :: Parser (Pattern, Expression) -letBindingBodyP = - Language.OCaml.Parser.LetBindingBody.letBindingBodyP seqExprP - -matchCaseP :: Parser Case -matchCaseP = Language.OCaml.Parser.MatchCase.matchCaseP seqExprP - -postItemAttributesP :: Parser [(Loc String, Payload)] -postItemAttributesP = Language.OCaml.Parser.PostItemAttributes.postItemAttributesP structureP - -recordExprP :: Parser (Maybe Expression, [(Loc Longident, Expression)]) -recordExprP = Language.OCaml.Parser.RecordExpr.recordExprP exprP simpleExprP - -seqExprP :: Parser Expression -seqExprP = Language.OCaml.Parser.SeqExpr.seqExprP structureP - -simpleCoreTypeP :: Parser CoreType -simpleCoreTypeP = Language.OCaml.Parser.SimpleCoreType.simpleCoreTypeP coreTypeP - -simpleCoreType2P :: Parser CoreType -simpleCoreType2P = Language.OCaml.Parser.SimpleCoreType2.simpleCoreType2P coreTypeP - -simpleCoreTypeOrTupleP :: Parser CoreType -simpleCoreTypeOrTupleP = - Language.OCaml.Parser.SimpleCoreTypeOrTuple.simpleCoreTypeOrTupleP coreTypeP - -simpleExprP :: Parser Expression -simpleExprP = Language.OCaml.Parser.SimpleExpr.simpleExprP seqExprP exprP - -simpleLabeledExprListP :: Parser [(ArgLabel, Expression)] -simpleLabeledExprListP = - Language.OCaml.Parser.SimpleLabeledExprList.simpleLabeledExprListP seqExprP exprP - -simplePatternP :: Parser Pattern -simplePatternP = Language.OCaml.Parser.SimplePattern.simplePatternP patternP - -structureItemP :: Parser StructureItem -structureItemP = Language.OCaml.Parser.StructureItem.structureItemP structureP - -typeDeclarationP :: Parser (RecFlag, TypeDeclaration) -typeDeclarationP = Language.OCaml.Parser.TypeDeclaration.typeDeclarationP structureP - -typeDeclarationsP :: Parser (RecFlag, [TypeDeclaration]) -typeDeclarationsP = Language.OCaml.Parser.TypeDeclarations.typeDeclarationsP structureP - -typeKindP :: Parser (TypeKind, PrivateFlag, Maybe CoreType) -typeKindP = Language.OCaml.Parser.TypeKind.typeKindP structureP diff --git a/lib/Language/OCaml/Parser/Label.hs b/lib/Language/OCaml/Parser/Label.hs deleted file mode 100644 --- a/lib/Language/OCaml/Parser/Label.hs +++ /dev/null @@ -1,9 +0,0 @@ -module Language.OCaml.Parser.Label - ( labelP - ) where - -import Language.OCaml.Parser.Tokens -import Language.OCaml.Parser.Utils.Types - -labelP :: Parser String -labelP = lIdentT diff --git a/lib/Language/OCaml/Parser/LabelDeclaration.hs b/lib/Language/OCaml/Parser/LabelDeclaration.hs deleted file mode 100644 --- a/lib/Language/OCaml/Parser/LabelDeclaration.hs +++ /dev/null @@ -1,24 +0,0 @@ -module Language.OCaml.Parser.LabelDeclaration - ( labelDeclarationP - ) where - -import Data.Default -import Text.Megaparsec hiding (label) - -import Language.OCaml.Definitions.Parsing.ASTHelper.Type as Type -import Language.OCaml.Definitions.Parsing.ParseTree -import Language.OCaml.Parser.Common -import Language.OCaml.Parser.Label -import Language.OCaml.Parser.MutableFlag -import Language.OCaml.Parser.PolyTypeNoAttr -import Language.OCaml.Parser.Tokens -import Language.OCaml.Parser.Utils.Types - -labelDeclarationP :: Parser LabelDeclaration -labelDeclarationP = try $ do - _mut <- mutableFlagP - label <- labelP - colonT - t <- polyTypeNoAttrP - -- TODO: attributes - return $ field def (mkRHS label 2) t -- FIXME: def diff --git a/lib/Language/OCaml/Parser/LabelDeclarationSemi.hs b/lib/Language/OCaml/Parser/LabelDeclarationSemi.hs deleted file mode 100644 --- a/lib/Language/OCaml/Parser/LabelDeclarationSemi.hs +++ /dev/null @@ -1,26 +0,0 @@ -module Language.OCaml.Parser.LabelDeclarationSemi - ( labelDeclarationSemiP - ) where - -import Data.Default -import Text.Megaparsec hiding (label) - -import Language.OCaml.Definitions.Parsing.ASTHelper.Type as Type -import Language.OCaml.Definitions.Parsing.ParseTree -import Language.OCaml.Parser.Common -import Language.OCaml.Parser.Label -import Language.OCaml.Parser.MutableFlag -import Language.OCaml.Parser.PolyTypeNoAttr -import Language.OCaml.Parser.Tokens -import Language.OCaml.Parser.Utils.Types - -labelDeclarationSemiP :: Parser LabelDeclaration -labelDeclarationSemiP = try $ do - _mut <- mutableFlagP - label <- labelP - colonT - t <- polyTypeNoAttrP - -- TODO: attributes - semiT - -- TODO: attributes - return $ Type.field def (mkRHS label 2) t -- FIXME: def diff --git a/lib/Language/OCaml/Parser/LabelDeclarations.hs b/lib/Language/OCaml/Parser/LabelDeclarations.hs deleted file mode 100644 --- a/lib/Language/OCaml/Parser/LabelDeclarations.hs +++ /dev/null @@ -1,20 +0,0 @@ -module Language.OCaml.Parser.LabelDeclarations - ( labelDeclarationsP - ) where - -import Text.Megaparsec - -import Language.OCaml.Definitions.Parsing.ParseTree -import Language.OCaml.Parser.LabelDeclaration -import Language.OCaml.Parser.LabelDeclarationSemi -import Language.OCaml.Parser.Utils.Types - -labelDeclarationsP :: Parser [LabelDeclaration] -labelDeclarationsP = choice - [ do - h <- labelDeclarationSemiP - t <- labelDeclarationsP - return $ h : t - , (: []) <$> labelDeclarationSemiP - , (: []) <$> labelDeclarationP - ] diff --git a/lib/Language/OCaml/Parser/LabelLongident.hs b/lib/Language/OCaml/Parser/LabelLongident.hs deleted file mode 100644 --- a/lib/Language/OCaml/Parser/LabelLongident.hs +++ /dev/null @@ -1,20 +0,0 @@ -module Language.OCaml.Parser.LabelLongident - ( labelLongidentP - ) where - -import Text.Megaparsec - -import Language.OCaml.Definitions.Parsing.ParseTree -import Language.OCaml.Parser.ModLongident -import Language.OCaml.Parser.Tokens -import Language.OCaml.Parser.Utils.Types - -labelLongidentP :: Parser Longident -labelLongidentP = choice - [ Lident <$> lIdentT - , do - m <- modLongidentP - dotT - i <- lIdentT - return $ Ldot m i - ] diff --git a/lib/Language/OCaml/Parser/LabeledSimpleExpr.hs b/lib/Language/OCaml/Parser/LabeledSimpleExpr.hs deleted file mode 100644 --- a/lib/Language/OCaml/Parser/LabeledSimpleExpr.hs +++ /dev/null @@ -1,18 +0,0 @@ -module Language.OCaml.Parser.LabeledSimpleExpr - ( labeledSimpleExprP - ) where - -import Text.Megaparsec - -import Language.OCaml.Definitions.Parsing.ASTTypes -import Language.OCaml.Definitions.Parsing.ParseTree -import Language.OCaml.Parser.SimpleExpr -import Language.OCaml.Parser.Utils.Types - -labeledSimpleExprP :: Parser Expression -> Parser Expression -> Parser (ArgLabel, Expression) -labeledSimpleExprP seqExprP exprP = choice - [ do - e <- simpleExprP seqExprP exprP - return (Nolabel, e) - -- TODO: labelExpr - ] diff --git a/lib/Language/OCaml/Parser/LabeledSimplePattern.hs b/lib/Language/OCaml/Parser/LabeledSimplePattern.hs deleted file mode 100644 --- a/lib/Language/OCaml/Parser/LabeledSimplePattern.hs +++ /dev/null @@ -1,18 +0,0 @@ -module Language.OCaml.Parser.LabeledSimplePattern - ( labeledSimplePatternP - ) where - -import Text.Megaparsec - -import Language.OCaml.Definitions.Parsing.ASTTypes -import Language.OCaml.Definitions.Parsing.ParseTree -import Language.OCaml.Parser.SimplePattern -import Language.OCaml.Parser.Utils.Types - -labeledSimplePatternP :: Parser Pattern -> Parser (ArgLabel, Maybe a, Pattern) -labeledSimplePatternP patternP = choice - [ -- TODO: lots of things - do - p <- simplePatternP patternP - return (Nolabel, Nothing, p) - ] diff --git a/lib/Language/OCaml/Parser/LblExpr.hs b/lib/Language/OCaml/Parser/LblExpr.hs deleted file mode 100644 --- a/lib/Language/OCaml/Parser/LblExpr.hs +++ /dev/null @@ -1,23 +0,0 @@ -module Language.OCaml.Parser.LblExpr - ( lblExprP - ) where - -import Text.Megaparsec - -import Language.OCaml.Definitions.Parsing.ASTTypes -import Language.OCaml.Definitions.Parsing.ParseTree -import Language.OCaml.Parser.Common -import Language.OCaml.Parser.LabelLongident -import Language.OCaml.Parser.OptTypeConstraint -import Language.OCaml.Parser.Tokens -import Language.OCaml.Parser.Utils.Types - -lblExprP :: Parser Expression -> Parser (Loc Longident, Expression) -lblExprP exprP = choice - [ do - i <- labelLongidentP - c <- optTypeConstraintP - equalT - e <- exprP - return (mkRHS i 1, mkexpOptConstraint e c) - ] diff --git a/lib/Language/OCaml/Parser/LblExprList.hs b/lib/Language/OCaml/Parser/LblExprList.hs deleted file mode 100644 --- a/lib/Language/OCaml/Parser/LblExprList.hs +++ /dev/null @@ -1,31 +0,0 @@ -module Language.OCaml.Parser.LblExprList - ( lblExprListP - ) where - -import Text.Megaparsec - -import Language.OCaml.Definitions.Parsing.ASTTypes -import Language.OCaml.Definitions.Parsing.ParseTree -import Language.OCaml.Parser.LblExpr -import Language.OCaml.Parser.Tokens -import Language.OCaml.Parser.Utils.Types - --- FIXME: Right now, this is made to look like the OCaml parser, but we could --- optimize everything by factoring out the left parsers that are the same. - -lblExprListP :: Parser Expression -> Parser [(Loc Longident, Expression)] -lblExprListP exprP = choice - [ try $ do - e <- lblExprP' - semiT - l <- lblExprListP' - return $ e : l - , try $ do - e <- lblExprP' - semiT - return [e] - , (: []) <$> lblExprP' - ] - where - lblExprP' = lblExprP exprP - lblExprListP' = lblExprListP exprP diff --git a/lib/Language/OCaml/Parser/LblPattern.hs b/lib/Language/OCaml/Parser/LblPattern.hs deleted file mode 100644 --- a/lib/Language/OCaml/Parser/LblPattern.hs +++ /dev/null @@ -1,29 +0,0 @@ -module Language.OCaml.Parser.LblPattern - ( lblPatternP - ) where - -import Text.Megaparsec - -import Language.OCaml.Definitions.Parsing.ASTTypes -import Language.OCaml.Definitions.Parsing.ParseTree -import Language.OCaml.Parser.Common -import Language.OCaml.Parser.LabelLongident -import Language.OCaml.Parser.OptPatternTypeConstraint -import Language.OCaml.Parser.Tokens -import Language.OCaml.Parser.Utils.Types - -lblPatternP :: Parser Pattern -> Parser (Loc Longident, Pattern) -lblPatternP patternP = choice - [ do - (i, c) <- try $ do - i <- labelLongidentP - c <- optPatternTypeConstraintP - equalT - return (i, c) - p <- patternP - return (mkRHS i 1, mkpatOptConstraint p c) - , do - i <- labelLongidentP - c <- optPatternTypeConstraintP - return (mkRHS i 1, mkpatOptConstraint (patOfLabel i 1) c) - ] diff --git a/lib/Language/OCaml/Parser/LblPatternList.hs b/lib/Language/OCaml/Parser/LblPatternList.hs deleted file mode 100644 --- a/lib/Language/OCaml/Parser/LblPatternList.hs +++ /dev/null @@ -1,40 +0,0 @@ -module Language.OCaml.Parser.LblPatternList - ( lblPatternListP - ) where - -import Text.Megaparsec - -import Language.OCaml.Definitions.Parsing.ASTTypes -import Language.OCaml.Definitions.Parsing.ParseTree -import Language.OCaml.Parser.LblPattern -import Language.OCaml.Parser.OptSemi -import Language.OCaml.Parser.Tokens -import Language.OCaml.Parser.Utils.Types - --- FIXME: Right now, this is made to look like the OCaml parser, but we could --- optimize everything by factoring out the left parsers that are the same. - -lblPatternListP :: Parser Pattern -> Parser ([(Loc Longident, Pattern)], ClosedFlag) -lblPatternListP patternP = choice - [ try $ do - p <- lblPatternP' - semiT - (fields, closed) <- lblPatternListP' - return (p : fields, closed) - , try $ do - p <- lblPatternP' - semiT - underscoreT - optSemiP - return ([p], Open) - , try $ do - p <- lblPatternP' - semiT - return ([p], Closed) - , do - p <- lblPatternP' - return ([p], Closed) - ] - where - lblPatternP' = lblPatternP patternP - lblPatternListP' = lblPatternListP patternP diff --git a/lib/Language/OCaml/Parser/LetBinding.hs b/lib/Language/OCaml/Parser/LetBinding.hs deleted file mode 100644 --- a/lib/Language/OCaml/Parser/LetBinding.hs +++ /dev/null @@ -1,23 +0,0 @@ -module Language.OCaml.Parser.LetBinding - ( letBindingP - ) where - -import Text.Megaparsec - -import Language.OCaml.Definitions.Parsing.Parser.LetBindings -import Language.OCaml.Definitions.Parsing.ParseTree -import Language.OCaml.Parser.Common -import Language.OCaml.Parser.LetBindingBody -import Language.OCaml.Parser.PostItemAttributes -import Language.OCaml.Parser.RecFlag -import Language.OCaml.Parser.Tokens -import Language.OCaml.Parser.Utils.Types - -letBindingP :: Parser Structure -> Parser Expression -> Parser LetBindings -letBindingP structureP seqExprP = do - try letT - -- TODO: extAttributes - r <- recFlagP - b <- letBindingBodyP seqExprP - _a <- postItemAttributesP structureP - return $ mklbs Nothing r (mklb True b []) -- FIXME diff --git a/lib/Language/OCaml/Parser/LetBindingBody.hs b/lib/Language/OCaml/Parser/LetBindingBody.hs deleted file mode 100644 --- a/lib/Language/OCaml/Parser/LetBindingBody.hs +++ /dev/null @@ -1,61 +0,0 @@ -module Language.OCaml.Parser.LetBindingBody - ( letBindingBodyP - ) where - -import Text.Megaparsec - -import Language.OCaml.Definitions.Parsing.ParseTree -import Language.OCaml.Parser.Common -import Language.OCaml.Parser.CoreType -import Language.OCaml.Parser.FunBinding -import Language.OCaml.Parser.Pattern -import Language.OCaml.Parser.PatternNoExn -import Language.OCaml.Parser.SimplePatternNotIdent -import Language.OCaml.Parser.StrictBinding -import Language.OCaml.Parser.Tokens -import Language.OCaml.Parser.TypeConstraint -import Language.OCaml.Parser.ValIdent -import Language.OCaml.Parser.Utils.Types - -letBindingBodyP :: Parser Expression -> Parser (Pattern, Expression) -letBindingBodyP seqExprP = choice - [ try $ do - i <- valIdentP - b <- strictBindingP seqExprP (funBindingP seqExprP) - return (mkpatvar i 1, b) - , do - (i, c) <- try $ do - i <- valIdentP - c <- typeConstraintP - return (i, c) - equalT - e <- seqExprP - let v = mkpatvar i 1 - let t = case c of - (Just t', Nothing) -> t' - (_, Just t') -> t' - _ -> error "This should not happen" - return ( ghpat $ PpatConstraint v (ghtyp $ PtypPoly [] t) - , mkexpConstraint e c - ) - -- TODO: typevarList - -- TODO: lidentList - , do - p <- try $ do - p <- patternNoExnP - equalT - return p - e <- seqExprP - return (p, e) - , do - p <- try $ do - p <- simplePatternNotIdentP patternP - colonT - return p - t <- coreTypeP - equalT - e <- seqExprP - return ( ghpat $ PpatConstraint p t - , e - ) - ] diff --git a/lib/Language/OCaml/Parser/LetBindings.hs b/lib/Language/OCaml/Parser/LetBindings.hs deleted file mode 100644 --- a/lib/Language/OCaml/Parser/LetBindings.hs +++ /dev/null @@ -1,28 +0,0 @@ -module Language.OCaml.Parser.LetBindings - ( letBindingsP - ) where - -import Text.Megaparsec - -import Language.OCaml.Definitions.Parsing.ParseTree -import Language.OCaml.Definitions.Parsing.Parser.LetBindings -import Language.OCaml.Parser.Common --- import Language.OCaml.Parser.Attributes -import Language.OCaml.Parser.LetBinding -import Language.OCaml.Parser.LetBindingBody -import Language.OCaml.Parser.PostItemAttributes -import Language.OCaml.Parser.Tokens -import Language.OCaml.Parser.Utils.Combinators -import Language.OCaml.Parser.Utils.Types - -letBindingsP :: Parser Structure -> Parser Expression -> Parser LetBindings -letBindingsP structureP seqExprP = leftRecursive - [ letBindingP structureP seqExprP - ] - [ do - try $ andT - -- a <- attributesP - b <- letBindingBodyP seqExprP - _p <- postItemAttributesP structureP - return $ \ x -> addlb x (mklb False b []) -- FIXME - ] diff --git a/lib/Language/OCaml/Parser/MatchCase.hs b/lib/Language/OCaml/Parser/MatchCase.hs deleted file mode 100644 --- a/lib/Language/OCaml/Parser/MatchCase.hs +++ /dev/null @@ -1,33 +0,0 @@ -module Language.OCaml.Parser.MatchCase - ( matchCaseP - ) where - -import Data.Default -import Text.Megaparsec - -import Language.OCaml.Definitions.Parsing.ASTHelper.Exp as Exp hiding (try) -import Language.OCaml.Definitions.Parsing.ParseTree -import Language.OCaml.Parser.Pattern -import Language.OCaml.Parser.Tokens -import Language.OCaml.Parser.Utils.Types - -matchCaseP :: Parser Expression -> Parser Case -matchCaseP seqExprP = choice - [ do - p <- try $ do - p <- patternP - minusGreaterT - return p - e <- seqExprP - return $ Exp.case' def p e - , do - p <- try $ do - p <- patternP - whenT - return p - w <- seqExprP - minusGreaterT - e <- seqExprP - return $ Exp.case' (def { guard = Just w }) p e - -- TODO: others - ] diff --git a/lib/Language/OCaml/Parser/MatchCases.hs b/lib/Language/OCaml/Parser/MatchCases.hs deleted file mode 100644 --- a/lib/Language/OCaml/Parser/MatchCases.hs +++ /dev/null @@ -1,13 +0,0 @@ -module Language.OCaml.Parser.MatchCases - ( matchCasesP - ) where - -import Language.OCaml.Definitions.Parsing.ParseTree -import Language.OCaml.Parser.MatchCase -import Language.OCaml.Parser.Tokens -import Language.OCaml.Parser.Utils.Combinators -import Language.OCaml.Parser.Utils.Types - -matchCasesP :: Parser Expression -> Parser [Case] -matchCasesP seqExprP = - chainl1' (matchCaseP seqExprP) (barT *> return (flip (:))) (: []) diff --git a/lib/Language/OCaml/Parser/ModExtLongident.hs b/lib/Language/OCaml/Parser/ModExtLongident.hs deleted file mode 100644 --- a/lib/Language/OCaml/Parser/ModExtLongident.hs +++ /dev/null @@ -1,21 +0,0 @@ -module Language.OCaml.Parser.ModExtLongident - ( modExtLongidentP - ) where - -import Text.Megaparsec - -import Language.OCaml.Definitions.Parsing.ParseTree -import Language.OCaml.Parser.Tokens -import Language.OCaml.Parser.Utils.Combinators -import Language.OCaml.Parser.Utils.Types - -modExtLongidentP :: Parser Longident -modExtLongidentP = leftRecursive - [ Lident <$> uIdentT - ] - [ try $ do - dotT - i <- uIdentT - return $ \ x -> Ldot x i - -- TODO: parens - ] diff --git a/lib/Language/OCaml/Parser/ModLongident.hs b/lib/Language/OCaml/Parser/ModLongident.hs deleted file mode 100644 --- a/lib/Language/OCaml/Parser/ModLongident.hs +++ /dev/null @@ -1,11 +0,0 @@ -module Language.OCaml.Parser.ModLongident - ( modLongidentP - ) where - -import Language.OCaml.Definitions.Parsing.ParseTree -import Language.OCaml.Parser.Tokens -import Language.OCaml.Parser.Utils.Combinators -import Language.OCaml.Parser.Utils.Types - -modLongidentP :: Parser Longident -modLongidentP = chainl1try' uIdentT (dotT *> return Ldot) Lident diff --git a/lib/Language/OCaml/Parser/ModuleBinding.hs b/lib/Language/OCaml/Parser/ModuleBinding.hs deleted file mode 100644 --- a/lib/Language/OCaml/Parser/ModuleBinding.hs +++ /dev/null @@ -1,25 +0,0 @@ -module Language.OCaml.Parser.ModuleBinding - ( moduleBindingP - ) where - -import Data.Default -import Text.Megaparsec - -import Language.OCaml.Definitions.Parsing.ASTHelper.Mb as Mb -import Language.OCaml.Definitions.Parsing.ParseTree -import Language.OCaml.Parser.Common -import Language.OCaml.Parser.ModuleBindingBody -import Language.OCaml.Parser.PostItemAttributes -import Language.OCaml.Parser.Tokens -import Language.OCaml.Parser.Utils.Types - -moduleBindingP :: Parser Structure -> Parser (ModuleBinding, ()) -moduleBindingP structureP = do - try $ moduleT - -- TODO: extAttributes - i <- uIdentT - b <- moduleBindingBodyP - _a <- postItemAttributesP structureP - return $ (Mb.mk def (mkRHS i 3) b -- FIXME - , () -- FIXME - ) diff --git a/lib/Language/OCaml/Parser/ModuleBindingBody.hs b/lib/Language/OCaml/Parser/ModuleBindingBody.hs deleted file mode 100644 --- a/lib/Language/OCaml/Parser/ModuleBindingBody.hs +++ /dev/null @@ -1,18 +0,0 @@ -module Language.OCaml.Parser.ModuleBindingBody - ( moduleBindingBodyP - ) where - -import Text.Megaparsec - -import Language.OCaml.Definitions.Parsing.ParseTree -import Language.OCaml.Parser.ModuleExpr -import Language.OCaml.Parser.Tokens -import Language.OCaml.Parser.Utils.Types - -moduleBindingBodyP :: Parser ModuleExpr -moduleBindingBodyP = choice - [ do - try $ equalT - moduleExprP - -- TODO: rest - ] diff --git a/lib/Language/OCaml/Parser/ModuleExpr.hs b/lib/Language/OCaml/Parser/ModuleExpr.hs deleted file mode 100644 --- a/lib/Language/OCaml/Parser/ModuleExpr.hs +++ /dev/null @@ -1,17 +0,0 @@ -module Language.OCaml.Parser.ModuleExpr - ( moduleExprP - ) where - -import Text.Megaparsec - -import Language.OCaml.Definitions.Parsing.ParseTree -import Language.OCaml.Parser.Common -import Language.OCaml.Parser.ModLongident -import Language.OCaml.Parser.Utils.Types - -moduleExprP :: Parser ModuleExpr -moduleExprP = choice - [ do - i <- modLongidentP - return . mkmod Nothing $ PmodIdent (mkRHS i 1) - ] diff --git a/lib/Language/OCaml/Parser/MutableFlag.hs b/lib/Language/OCaml/Parser/MutableFlag.hs deleted file mode 100644 --- a/lib/Language/OCaml/Parser/MutableFlag.hs +++ /dev/null @@ -1,15 +0,0 @@ -module Language.OCaml.Parser.MutableFlag - ( mutableFlagP - ) where - -import Text.Megaparsec - -import Language.OCaml.Definitions.Parsing.ParseTree -import Language.OCaml.Parser.Tokens -import Language.OCaml.Parser.Utils.Types - -mutableFlagP :: Parser MutableFlag -mutableFlagP = choice - [ mutableT *> return Mutable - , return Immutable - ] diff --git a/lib/Language/OCaml/Parser/NonRecFlag.hs b/lib/Language/OCaml/Parser/NonRecFlag.hs deleted file mode 100644 --- a/lib/Language/OCaml/Parser/NonRecFlag.hs +++ /dev/null @@ -1,15 +0,0 @@ -module Language.OCaml.Parser.NonRecFlag - ( nonrecFlagP - ) where - -import Text.Megaparsec - -import qualified Language.OCaml.Definitions.Parsing.ASTTypes as ASTTypes -import Language.OCaml.Parser.Tokens -import Language.OCaml.Parser.Utils.Types - -nonrecFlagP :: Parser ASTTypes.RecFlag -nonrecFlagP = choice - [ nonrecT *> return ASTTypes.NonRecursive - , return ASTTypes.Recursive - ] diff --git a/lib/Language/OCaml/Parser/OpenStatement.hs b/lib/Language/OCaml/Parser/OpenStatement.hs deleted file mode 100644 --- a/lib/Language/OCaml/Parser/OpenStatement.hs +++ /dev/null @@ -1,37 +0,0 @@ -{-# LANGUAGE NamedFieldPuns #-} - -module Language.OCaml.Parser.OpenStatement - ( openStatementP - ) where - -import Data.Default -import Text.Megaparsec - -import Language.OCaml.Definitions.Parsing.ASTHelper.Opn as Opn -import Language.OCaml.Definitions.Parsing.ParseTree -import Language.OCaml.Parser.Common (mkRHS, symbolRLoc, symbolDocs) --- import Language.OCaml.Parser.ExtAttributes -import Language.OCaml.Parser.ModLongident -import Language.OCaml.Parser.OverrideFlag -import Language.OCaml.Parser.PostItemAttributes -import Language.OCaml.Parser.Tokens -import Language.OCaml.Parser.Utils.Types - -openStatementP :: Parser Structure -> Parser (OpenDescription, ()) -openStatementP structureP = do - try $ openT - override <- overrideFlagP - -- (ext, attrs) <- extAttributesP - i <- modLongidentP - a <- postItemAttributesP structureP - return ( - Opn.mk - (def { override - , attrs = a -- FIXME: ++ attrs - , loc = symbolRLoc () - , docs = symbolDocs () - } - ) - (mkRHS i 4) - , () -- FIXME: ext - ) diff --git a/lib/Language/OCaml/Parser/Operator.hs b/lib/Language/OCaml/Parser/Operator.hs deleted file mode 100644 --- a/lib/Language/OCaml/Parser/Operator.hs +++ /dev/null @@ -1,17 +0,0 @@ -module Language.OCaml.Parser.Operator - ( operatorP - ) where - -import Text.Megaparsec - -import Language.OCaml.Parser.Tokens -import Language.OCaml.Parser.Utils.Types - -operatorP :: Parser String -operatorP = choice - [ - -- TODO - bangT *> return "!" - , plusT *> return "+" - , minusT *> return "-" - ] diff --git a/lib/Language/OCaml/Parser/OptBar.hs b/lib/Language/OCaml/Parser/OptBar.hs deleted file mode 100644 --- a/lib/Language/OCaml/Parser/OptBar.hs +++ /dev/null @@ -1,14 +0,0 @@ -module Language.OCaml.Parser.OptBar - ( optBarP - ) where - -import Text.Megaparsec - -import Language.OCaml.Parser.Tokens -import Language.OCaml.Parser.Utils.Types - -optBarP :: Parser () -optBarP = choice - [ barT *> return () - , return () - ] diff --git a/lib/Language/OCaml/Parser/OptPatternTypeConstraint.hs b/lib/Language/OCaml/Parser/OptPatternTypeConstraint.hs deleted file mode 100644 --- a/lib/Language/OCaml/Parser/OptPatternTypeConstraint.hs +++ /dev/null @@ -1,16 +0,0 @@ -module Language.OCaml.Parser.OptPatternTypeConstraint - ( optPatternTypeConstraintP - ) where - -import Text.Megaparsec - -import Language.OCaml.Definitions.Parsing.ParseTree -import Language.OCaml.Parser.CoreType -import Language.OCaml.Parser.Tokens -import Language.OCaml.Parser.Utils.Types - -optPatternTypeConstraintP :: Parser (Maybe CoreType) -optPatternTypeConstraintP = choice - [ Just <$> (colonT *> coreTypeP) - , return Nothing - ] diff --git a/lib/Language/OCaml/Parser/OptSemi.hs b/lib/Language/OCaml/Parser/OptSemi.hs deleted file mode 100644 --- a/lib/Language/OCaml/Parser/OptSemi.hs +++ /dev/null @@ -1,14 +0,0 @@ -module Language.OCaml.Parser.OptSemi - ( optSemiP - ) where - -import Text.Megaparsec - -import Language.OCaml.Parser.Tokens -import Language.OCaml.Parser.Utils.Types - -optSemiP :: Parser () -optSemiP = choice - [ semiT - , return () - ] diff --git a/lib/Language/OCaml/Parser/OptTypeConstraint.hs b/lib/Language/OCaml/Parser/OptTypeConstraint.hs deleted file mode 100644 --- a/lib/Language/OCaml/Parser/OptTypeConstraint.hs +++ /dev/null @@ -1,15 +0,0 @@ -module Language.OCaml.Parser.OptTypeConstraint - ( optTypeConstraintP - ) where - -import Text.Megaparsec - -import Language.OCaml.Definitions.Parsing.ParseTree -import Language.OCaml.Parser.TypeConstraint -import Language.OCaml.Parser.Utils.Types - -optTypeConstraintP :: Parser (Maybe (Maybe CoreType, Maybe CoreType)) -optTypeConstraintP = choice - [ Just <$> typeConstraintP - , return Nothing - ] diff --git a/lib/Language/OCaml/Parser/OptionalTypeParameter.hs b/lib/Language/OCaml/Parser/OptionalTypeParameter.hs deleted file mode 100644 --- a/lib/Language/OCaml/Parser/OptionalTypeParameter.hs +++ /dev/null @@ -1,15 +0,0 @@ -module Language.OCaml.Parser.OptionalTypeParameter - ( optionalTypeParameterP - ) where - -import Language.OCaml.Definitions.Parsing.ASTTypes -import Language.OCaml.Definitions.Parsing.ParseTree -import Language.OCaml.Parser.OptionalTypeVariable -import Language.OCaml.Parser.TypeVariance -import Language.OCaml.Parser.Utils.Types - -optionalTypeParameterP :: Parser (CoreType, Variance) -optionalTypeParameterP = do - v <- typeVarianceP - t <- optionalTypeVariableP - return (t, v) diff --git a/lib/Language/OCaml/Parser/OptionalTypeParameters.hs b/lib/Language/OCaml/Parser/OptionalTypeParameters.hs deleted file mode 100644 --- a/lib/Language/OCaml/Parser/OptionalTypeParameters.hs +++ /dev/null @@ -1,18 +0,0 @@ -module Language.OCaml.Parser.OptionalTypeParameters - ( optionalTypeParametersP - ) where - -import Text.Megaparsec - -import Language.OCaml.Definitions.Parsing.ASTTypes -import Language.OCaml.Definitions.Parsing.ParseTree -import Language.OCaml.Parser.OptionalTypeParameter -import Language.OCaml.Parser.Utils.Types -import Language.OCaml.Parser.Utils.Utils - -optionalTypeParametersP :: Parser [(CoreType, Variance)] -optionalTypeParametersP = choice - [ (: []) <$> optionalTypeParameterP - , parens (many optionalTypeParameterP) - , pure [] - ] diff --git a/lib/Language/OCaml/Parser/OptionalTypeVariable.hs b/lib/Language/OCaml/Parser/OptionalTypeVariable.hs deleted file mode 100644 --- a/lib/Language/OCaml/Parser/OptionalTypeVariable.hs +++ /dev/null @@ -1,12 +0,0 @@ -module Language.OCaml.Parser.OptionalTypeVariable - ( optionalTypeVariableP - ) where - - -import Language.OCaml.Definitions.Parsing.ParseTree -import Language.OCaml.Parser.Common -import Language.OCaml.Parser.Tokens -import Language.OCaml.Parser.Utils.Types - -optionalTypeVariableP :: Parser CoreType -optionalTypeVariableP = mktyp . PtypVar <$> (quoteT *> identP) diff --git a/lib/Language/OCaml/Parser/OverrideFlag.hs b/lib/Language/OCaml/Parser/OverrideFlag.hs deleted file mode 100644 --- a/lib/Language/OCaml/Parser/OverrideFlag.hs +++ /dev/null @@ -1,15 +0,0 @@ -module Language.OCaml.Parser.OverrideFlag - ( overrideFlagP - ) where - -import Text.Megaparsec - -import qualified Language.OCaml.Definitions.Parsing.ASTTypes as ASTTypes -import Language.OCaml.Parser.Tokens -import Language.OCaml.Parser.Utils.Types - -overrideFlagP :: Parser ASTTypes.OverrideFlag -overrideFlagP = choice - [ bangT *> return ASTTypes.Override - , return ASTTypes.Fresh - ] diff --git a/lib/Language/OCaml/Parser/Pattern.hs b/lib/Language/OCaml/Parser/Pattern.hs deleted file mode 100644 --- a/lib/Language/OCaml/Parser/Pattern.hs +++ /dev/null @@ -1,40 +0,0 @@ -module Language.OCaml.Parser.Pattern - ( patternP - ) where - -import Text.Megaparsec - -import Language.OCaml.Definitions.Parsing.ParseTree -import Language.OCaml.Parser.Common -import Language.OCaml.Parser.PatternGen -import Language.OCaml.Parser.Tokens -import Language.OCaml.Parser.ValIdent -import Language.OCaml.Parser.Utils.Combinators -import Language.OCaml.Parser.Utils.Types - -patternP :: Parser Pattern -patternP = choice - [ try $ parser <* notFollowedBy commaT - , mkpat . PpatTuple <$> - chainl1' parser (commaT *> (return $ flip (:))) (: []) - ] - where - parser = leftRecursive - [ patternGenP patternP - ] - -- pattern AS valIdent - [ do - try $ asT - i <- valIdentP - return $ \ x -> mkpat $ PpatAlias x (mkRHS i 3) - -- pattern COLONCOLON pattern - , do - try $ colonColonT - p2 <- patternP - return $ \ p1 -> mkpatCons (rhsLoc 2) (ghpat $ PpatTuple [p1, p2]) (symbolRLoc ()) - , do - try $ barT - p <- patternP - return $ \ x -> mkpat $ PpatOr x p - -- TODO: bunch of other patterns - ] diff --git a/lib/Language/OCaml/Parser/PatternGen.hs b/lib/Language/OCaml/Parser/PatternGen.hs deleted file mode 100644 --- a/lib/Language/OCaml/Parser/PatternGen.hs +++ /dev/null @@ -1,22 +0,0 @@ -module Language.OCaml.Parser.PatternGen - ( patternGenP - ) where - -import Text.Megaparsec - -import Language.OCaml.Definitions.Parsing.ParseTree -import Language.OCaml.Parser.Common -import Language.OCaml.Parser.ConstrLongident -import Language.OCaml.Parser.SimplePattern -import Language.OCaml.Parser.Utils.Types - -patternGenP :: Parser Pattern -> Parser Pattern -patternGenP patternP = choice - [ try $ do - i <- constrLongidentP - p <- patternP - return $ mkpat $ PpatConstruct (mkRHS i 1) (Just p) - , try $ simplePatternP' - ] - where - simplePatternP' = simplePatternP patternP diff --git a/lib/Language/OCaml/Parser/PatternNoExn.hs b/lib/Language/OCaml/Parser/PatternNoExn.hs deleted file mode 100644 --- a/lib/Language/OCaml/Parser/PatternNoExn.hs +++ /dev/null @@ -1,34 +0,0 @@ -module Language.OCaml.Parser.PatternNoExn - ( patternNoExnP - ) where - -import Text.Megaparsec - -import Language.OCaml.Definitions.Parsing.ParseTree -import Language.OCaml.Parser.Common -import Language.OCaml.Parser.Pattern -import Language.OCaml.Parser.PatternGen -import Language.OCaml.Parser.Tokens -import Language.OCaml.Parser.ValIdent -import Language.OCaml.Parser.Utils.Combinators -import Language.OCaml.Parser.Utils.Types - -patternNoExnP :: Parser Pattern -patternNoExnP = leftRecursive - [ patternGenP patternP - ] - [ do - try asT - i <- valIdentP - return $ \ x -> mkpat $ PpatAlias x (mkRHS i 3) - -- TODO: patternNoExnCommaList - -- , do - -- try colonColonT - -- p <- patternP - -- return $ mkpatCons _ _ - , do - try barT - p <- patternP - return $ \ x -> mkpat $ PpatOr x p - -- TODO: attribute - ] diff --git a/lib/Language/OCaml/Parser/PatternSemiList.hs b/lib/Language/OCaml/Parser/PatternSemiList.hs deleted file mode 100644 --- a/lib/Language/OCaml/Parser/PatternSemiList.hs +++ /dev/null @@ -1,18 +0,0 @@ -module Language.OCaml.Parser.PatternSemiList - ( patternSemiListP - ) where - -import Language.OCaml.Definitions.Parsing.ParseTree -import Language.OCaml.Parser.Tokens -import Language.OCaml.Parser.Utils.Combinators -import Language.OCaml.Parser.Utils.Types - -patternSemiListP :: Parser Pattern -> Parser [Pattern] -patternSemiListP patternP = leftRecursive - [ (: []) <$> patternP - ] - [ do - semiT - e2 <- patternP - return $ \ e1 -> e2 : e1 - ] diff --git a/lib/Language/OCaml/Parser/Payload.hs b/lib/Language/OCaml/Parser/Payload.hs deleted file mode 100644 --- a/lib/Language/OCaml/Parser/Payload.hs +++ /dev/null @@ -1,13 +0,0 @@ -module Language.OCaml.Parser.Payload - ( payloadP - ) where - -import Text.Megaparsec - -import Language.OCaml.Definitions.Parsing.ParseTree -import Language.OCaml.Parser.Utils.Types - -payloadP :: Parser Structure -> Parser Payload -payloadP structureP = choice - [ PStr <$> structureP - ] diff --git a/lib/Language/OCaml/Parser/PolyTypeNoAttr.hs b/lib/Language/OCaml/Parser/PolyTypeNoAttr.hs deleted file mode 100644 --- a/lib/Language/OCaml/Parser/PolyTypeNoAttr.hs +++ /dev/null @@ -1,16 +0,0 @@ -module Language.OCaml.Parser.PolyTypeNoAttr - ( polyTypeNoAttrP - ) where - -import Text.Megaparsec - -import Language.OCaml.Definitions.Parsing.ParseTree -import Language.OCaml.Parser.CoreType -import Language.OCaml.Parser.CoreTypeNoAttr -import Language.OCaml.Parser.Utils.Types - -polyTypeNoAttrP :: Parser CoreType -polyTypeNoAttrP = choice - [ coreTypenoAttrP coreTypeP - -- TODO - ] diff --git a/lib/Language/OCaml/Parser/PostItemAttribute.hs b/lib/Language/OCaml/Parser/PostItemAttribute.hs deleted file mode 100644 --- a/lib/Language/OCaml/Parser/PostItemAttribute.hs +++ /dev/null @@ -1,20 +0,0 @@ -module Language.OCaml.Parser.PostItemAttribute - ( postItemAttributeP - ) where - -import Text.Megaparsec - -import qualified Language.OCaml.Definitions.Parsing.ASTTypes as ASTTypes -import Language.OCaml.Definitions.Parsing.ParseTree -import Language.OCaml.Parser.AttrId -import Language.OCaml.Parser.Payload -import Language.OCaml.Parser.Tokens -import Language.OCaml.Parser.Utils.Types - -postItemAttributeP :: Parser Structure -> Parser (ASTTypes.Loc String, Payload) -postItemAttributeP structureP = do - try $ lBracketAtAtT - i <- attrIdP - p <- payloadP structureP - rBracketT - return (i, p) diff --git a/lib/Language/OCaml/Parser/PostItemAttributes.hs b/lib/Language/OCaml/Parser/PostItemAttributes.hs deleted file mode 100644 --- a/lib/Language/OCaml/Parser/PostItemAttributes.hs +++ /dev/null @@ -1,13 +0,0 @@ -module Language.OCaml.Parser.PostItemAttributes - ( postItemAttributesP - ) where - -import Text.Megaparsec - -import qualified Language.OCaml.Definitions.Parsing.ASTTypes as ASTTypes -import Language.OCaml.Definitions.Parsing.ParseTree -import Language.OCaml.Parser.PostItemAttribute -import Language.OCaml.Parser.Utils.Types - -postItemAttributesP :: Parser Structure -> Parser [(ASTTypes.Loc String, Payload)] -postItemAttributesP structureP = many (postItemAttributeP structureP) diff --git a/lib/Language/OCaml/Parser/PrivateFlag.hs b/lib/Language/OCaml/Parser/PrivateFlag.hs deleted file mode 100644 --- a/lib/Language/OCaml/Parser/PrivateFlag.hs +++ /dev/null @@ -1,15 +0,0 @@ -module Language.OCaml.Parser.PrivateFlag - ( privateFlagP - ) where - -import Text.Megaparsec - -import Language.OCaml.Definitions.Parsing.ParseTree -import Language.OCaml.Parser.Tokens -import Language.OCaml.Parser.Utils.Types - -privateFlagP :: Parser PrivateFlag -privateFlagP = choice - [ privateT *> return Private - , return Public - ] diff --git a/lib/Language/OCaml/Parser/RecFlag.hs b/lib/Language/OCaml/Parser/RecFlag.hs deleted file mode 100644 --- a/lib/Language/OCaml/Parser/RecFlag.hs +++ /dev/null @@ -1,15 +0,0 @@ -module Language.OCaml.Parser.RecFlag - ( recFlagP - ) where - -import Text.Megaparsec - -import qualified Language.OCaml.Definitions.Parsing.ASTTypes as ASTTypes -import Language.OCaml.Parser.Tokens -import Language.OCaml.Parser.Utils.Types - -recFlagP :: Parser ASTTypes.RecFlag -recFlagP = choice - [ recT *> return ASTTypes.Recursive - , return ASTTypes.NonRecursive - ] diff --git a/lib/Language/OCaml/Parser/RecordExpr.hs b/lib/Language/OCaml/Parser/RecordExpr.hs deleted file mode 100644 --- a/lib/Language/OCaml/Parser/RecordExpr.hs +++ /dev/null @@ -1,28 +0,0 @@ -module Language.OCaml.Parser.RecordExpr - ( recordExprP - ) where - -import Text.Megaparsec - -import Language.OCaml.Definitions.Parsing.ASTTypes -import Language.OCaml.Definitions.Parsing.ParseTree -import Language.OCaml.Parser.LblExprList -import Language.OCaml.Parser.Tokens -import Language.OCaml.Parser.Utils.Types - -recordExprP :: - Parser Expression -> Parser Expression -> Parser (Maybe Expression, [(Loc Longident, Expression)]) -recordExprP exprP simpleExprP = choice - [ do - e <- try $ do - e <- simpleExprP - withT - return e - l <- lblExprListP' - return (Just e, l) - , do - l <- lblExprListP' - return (Nothing, l) - ] - where - lblExprListP' = lblExprListP exprP diff --git a/lib/Language/OCaml/Parser/SeqExpr.hs b/lib/Language/OCaml/Parser/SeqExpr.hs deleted file mode 100644 --- a/lib/Language/OCaml/Parser/SeqExpr.hs +++ /dev/null @@ -1,30 +0,0 @@ -module Language.OCaml.Parser.SeqExpr - ( seqExprP - ) where - -import Data.Default -import Text.Megaparsec - -import Language.OCaml.Definitions.Parsing.ASTHelper.Exp as Exp hiding (try) -import Language.OCaml.Definitions.Parsing.ParseTree -import Language.OCaml.Parser.Expr -import Language.OCaml.Parser.Tokens -import Language.OCaml.Parser.Utils.Types - -seqExprP :: Parser Structure -> Parser Expression -seqExprP structureP = choice - [ try $ do - e <- exprP' - semiT - s <- seqExprP' - return $ Exp.mk def (PexpSequence e s) - , try $ do - e <- exprP' - semiT - return e - , try $ exprP' - -- TODO: percent - ] - where - exprP' = exprP structureP seqExprP' - seqExprP' = seqExprP structureP diff --git a/lib/Language/OCaml/Parser/SigExceptionDeclaration.hs b/lib/Language/OCaml/Parser/SigExceptionDeclaration.hs deleted file mode 100644 --- a/lib/Language/OCaml/Parser/SigExceptionDeclaration.hs +++ /dev/null @@ -1,39 +0,0 @@ -{-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE NamedFieldPuns #-} - -module Language.OCaml.Parser.SigExceptionDeclaration - ( sigExceptionDeclarationP - ) where - -import Data.Default - -import Language.OCaml.Definitions.Parsing.ASTHelper.Te as Te -import Language.OCaml.Definitions.Parsing.ParseTree -import Language.OCaml.Parser.Common -import Language.OCaml.Parser.ConstrIdent -import Language.OCaml.Parser.CoreType -import Language.OCaml.Parser.GeneralizedConstructorArguments -import Language.OCaml.Parser.PostItemAttributes -import Language.OCaml.Parser.Tokens -import Language.OCaml.Parser.Utils.Types - -sigExceptionDeclarationP :: Parser Structure -> Parser (ExtensionConstructor, ()) -sigExceptionDeclarationP structureP = do - exceptionT - -- TODO: extAttributes - i <- constrIdentP - (args, res) <- generalizedConstructorArgumentsP coreTypeP - -- a <- attributesP - attrs <- postItemAttributesP structureP - return - ( Te.decl - (def { args - , attrs = attrs {- ++ a -} {- loc and docs -} - , loc = symbolRLoc () - , docs = symbolDocs () - } - ) - res - (mkRHS i (3 :: Int)) - , () - ) diff --git a/lib/Language/OCaml/Parser/SimpleCoreType.hs b/lib/Language/OCaml/Parser/SimpleCoreType.hs deleted file mode 100644 --- a/lib/Language/OCaml/Parser/SimpleCoreType.hs +++ /dev/null @@ -1,21 +0,0 @@ -module Language.OCaml.Parser.SimpleCoreType - ( simpleCoreTypeP - ) where - -import Text.Megaparsec - -import Language.OCaml.Definitions.Parsing.ParseTree -import Language.OCaml.Parser.CoreTypeCommaList -import Language.OCaml.Parser.SimpleCoreType2 -import Language.OCaml.Parser.Utils.Types -import Language.OCaml.Parser.Utils.Utils - -simpleCoreTypeP :: Parser CoreType -> Parser CoreType -simpleCoreTypeP coreTypeP = choice - [ try $ simpleCoreType2P coreTypeP - , do - l <- parens $ coreTypeCommaListP coreTypeP - case l of - [sty] -> return sty - _ -> fail "Parse error" - ] diff --git a/lib/Language/OCaml/Parser/SimpleCoreType2.hs b/lib/Language/OCaml/Parser/SimpleCoreType2.hs deleted file mode 100644 --- a/lib/Language/OCaml/Parser/SimpleCoreType2.hs +++ /dev/null @@ -1,38 +0,0 @@ -module Language.OCaml.Parser.SimpleCoreType2 - ( simpleCoreType2P - ) where - -import Text.Megaparsec - -import Language.OCaml.Definitions.Parsing.ParseTree -import Language.OCaml.Parser.Common -import Language.OCaml.Parser.CoreTypeCommaList -import Language.OCaml.Parser.Tokens -import Language.OCaml.Parser.TypeLongident -import Language.OCaml.Parser.Utils.Combinators -import Language.OCaml.Parser.Utils.Types - -simpleCoreType2P :: Parser CoreType -> Parser CoreType -simpleCoreType2P coreTypeP = leftRecursive - [ choice - [ mktyp . PtypVar <$> try (quoteT *> identP) - , mktyp . const PtypAny <$> underscoreT - , try $ do - t <- typeLongidentP - return $ mktyp $ PtypConstr (mkRHS t 1) [] - , do - lParenT - l <- coreTypeCommaListP coreTypeP - rParenT - i <- typeLongidentP - return . mktyp $ PtypConstr (mkRHS i 4)(reverse l) - -- , do - -- a <- chainl1' simpleCoreType2P _ _ -- (return $ \ a b -> PtypConstr (mkRHS b 2) [a]) - -- t <- typeLongidentP - -- return $ mkTyp $ PtypConstr (mkRHS t 2) [a] - ] - ] - [ do - t <- typeLongidentP - return $ \ x -> mktyp $ PtypConstr (mkRHS t 2) [x] - ] diff --git a/lib/Language/OCaml/Parser/SimpleCoreTypeOrTuple.hs b/lib/Language/OCaml/Parser/SimpleCoreTypeOrTuple.hs deleted file mode 100644 --- a/lib/Language/OCaml/Parser/SimpleCoreTypeOrTuple.hs +++ /dev/null @@ -1,26 +0,0 @@ -module Language.OCaml.Parser.SimpleCoreTypeOrTuple - ( simpleCoreTypeOrTupleP - ) where - -import Text.Megaparsec - -import Language.OCaml.Definitions.Parsing.ParseTree -import Language.OCaml.Parser.Common -import Language.OCaml.Parser.CoreTypeList -import Language.OCaml.Parser.SimpleCoreType -import Language.OCaml.Parser.Tokens -import Language.OCaml.Parser.Utils.Types - -simpleCoreTypeOrTupleP :: Parser CoreType -> Parser CoreType -simpleCoreTypeOrTupleP coreTypeP = choice - [ do - t <- try $ do - t <- simpleCoreTypeP' - starT - return t - l <- coreTypelistP coreTypeP - return . mktyp . PtypTuple $ t : reverse l - , simpleCoreTypeP' - ] - where - simpleCoreTypeP' = simpleCoreTypeP coreTypeP diff --git a/lib/Language/OCaml/Parser/SimpleDelimitedPattern.hs b/lib/Language/OCaml/Parser/SimpleDelimitedPattern.hs deleted file mode 100644 --- a/lib/Language/OCaml/Parser/SimpleDelimitedPattern.hs +++ /dev/null @@ -1,45 +0,0 @@ -module Language.OCaml.Parser.SimpleDelimitedPattern - ( simpleDelimitedPatternP - ) where - -import Text.Megaparsec - -import Language.OCaml.Definitions.Parsing.ParseTree -import Language.OCaml.Parser.Common -import Language.OCaml.Parser.LblPatternList -import Language.OCaml.Parser.OptSemi -import Language.OCaml.Parser.PatternSemiList -import Language.OCaml.Parser.Tokens -import Language.OCaml.Parser.Utils.Types - -simpleDelimitedPatternP :: Parser Pattern -> Parser Pattern -simpleDelimitedPatternP patternP = choice - [ do - (fields, closed) <- try $ do - lBraceT - lblPatternListP patternP - rBraceT - return $ mkpat $ PpatRecord fields closed - , do - l <- try $ do - lBracketT - l <- patternSemiListP patternP - optSemiP - return l - rBracketT - return $ mktailpat (rhsLoc 4) (reverse l) - , do - l <- try $ do - lBracketBarT - l <- patternSemiListP' - optSemiP - return l - barRBracketT - return $ mkpat $ PpatArray (reverse l) - , do - lBracketBarT - barRBracketT - return $ mkpat $ PpatArray [] - ] - where - patternSemiListP' = patternSemiListP patternP diff --git a/lib/Language/OCaml/Parser/SimpleExpr.hs b/lib/Language/OCaml/Parser/SimpleExpr.hs deleted file mode 100644 --- a/lib/Language/OCaml/Parser/SimpleExpr.hs +++ /dev/null @@ -1,50 +0,0 @@ -module Language.OCaml.Parser.SimpleExpr - ( simpleExprP - ) where - -import Language.OCaml.Definitions.Parsing.ParseTree -import Language.OCaml.Parser.Common -import Language.OCaml.Parser.Constant -import Language.OCaml.Parser.ConstrLongident -import Language.OCaml.Parser.ExprSemiList -import Language.OCaml.Parser.LabelLongident -import Language.OCaml.Parser.OptSemi -import Language.OCaml.Parser.RecordExpr -import Language.OCaml.Parser.ValLongident -import Language.OCaml.Parser.Tokens -import Language.OCaml.Parser.Utils.Combinators -import Language.OCaml.Parser.Utils.Types - -simpleExprP :: Parser Expression -> Parser Expression -> Parser Expression -simpleExprP seqExprP exprP = leftRecursive - [ do - i <- valLongidentP - return . mkexp $ PexpIdent (mkRHS i 1) - , mkexp . PexpConstant <$> constantP - , do - i <- constrLongidentP - return $ mkexp $ PexpConstruct (mkRHS i 1) Nothing - , do - lParenT - e <- seqExprP - rParenT - return $ relocExp e - , do - lBracketT - l <- exprSemiListP exprP - optSemiP - rBracketT - return $ relocExp $ mktailexp (rhsLoc 4) (reverse l) - , do - lBraceT - (exten, fields) <- recordExprP exprP simpleExprP' - rBraceT - return $ mkexp $ PexpRecord fields exten - ] - [ do - dotT - i <- labelLongidentP - return $ \ x -> mkexp $ PexpField x (mkRHS i 3) - ] - where - simpleExprP' = simpleExprP seqExprP exprP diff --git a/lib/Language/OCaml/Parser/SimpleLabeledExprList.hs b/lib/Language/OCaml/Parser/SimpleLabeledExprList.hs deleted file mode 100644 --- a/lib/Language/OCaml/Parser/SimpleLabeledExprList.hs +++ /dev/null @@ -1,16 +0,0 @@ -module Language.OCaml.Parser.SimpleLabeledExprList - ( simpleLabeledExprListP - ) where - -import Text.Megaparsec - -import Language.OCaml.Definitions.Parsing.ASTTypes -import Language.OCaml.Definitions.Parsing.ParseTree -import Language.OCaml.Parser.LabeledSimpleExpr -import Language.OCaml.Parser.Utils.Types - --- NOTE: the OCaml version builds the list backwards for efficiency reasons --- We call `reverse` to match it, even though it is inefficient. --- We could update this once the whole code base is ready. #FIXME -simpleLabeledExprListP :: Parser Expression -> Parser Expression -> Parser [(ArgLabel, Expression)] -simpleLabeledExprListP seqExprP exprP = reverse <$> many (labeledSimpleExprP seqExprP exprP) diff --git a/lib/Language/OCaml/Parser/SimplePattern.hs b/lib/Language/OCaml/Parser/SimplePattern.hs deleted file mode 100644 --- a/lib/Language/OCaml/Parser/SimplePattern.hs +++ /dev/null @@ -1,21 +0,0 @@ -module Language.OCaml.Parser.SimplePattern - ( simplePatternP - ) where - -import Text.Megaparsec - -import Language.OCaml.Definitions.Parsing.ParseTree -import Language.OCaml.Parser.Common -import Language.OCaml.Parser.SimplePatternNotIdent -import Language.OCaml.Parser.ValIdent -import Language.OCaml.Parser.Utils.Types - -simplePatternP :: Parser Pattern -> Parser Pattern -simplePatternP patternP = choice - [ do - i <- valIdentP - return $ mkpat $ PpatVar $ mkRHS i 1 - , simplePatternNotIdentP' - ] - where - simplePatternNotIdentP' = simplePatternNotIdentP patternP diff --git a/lib/Language/OCaml/Parser/SimplePatternNotIdent.hs b/lib/Language/OCaml/Parser/SimplePatternNotIdent.hs deleted file mode 100644 --- a/lib/Language/OCaml/Parser/SimplePatternNotIdent.hs +++ /dev/null @@ -1,33 +0,0 @@ -module Language.OCaml.Parser.SimplePatternNotIdent - ( simplePatternNotIdentP - ) where - -import Text.Megaparsec - -import Language.OCaml.Definitions.Parsing.ParseTree -import Language.OCaml.Parser.Common -import Language.OCaml.Parser.ConstrLongident -import Language.OCaml.Parser.SimpleDelimitedPattern -import Language.OCaml.Parser.Tokens -import Language.OCaml.Parser.Utils.Types - -simplePatternNotIdentP :: Parser Pattern -> Parser Pattern -simplePatternNotIdentP patternP = choice - [ do - underscoreT - return $ mkpat $ PpatAny - -- TODO: signed constants - , do - i <- constrLongidentP - return $ mkpat $ PpatConstruct (mkRHS i 1) Nothing - -- TODO: name_tag - -- TODO: HASH - , simpleDelimitedPatternP' - , do - lParenT - p <- patternP - rParenT - return $ relocPat p - ] - where - simpleDelimitedPatternP' = simpleDelimitedPatternP patternP diff --git a/lib/Language/OCaml/Parser/SingleAttrId.hs b/lib/Language/OCaml/Parser/SingleAttrId.hs deleted file mode 100644 --- a/lib/Language/OCaml/Parser/SingleAttrId.hs +++ /dev/null @@ -1,15 +0,0 @@ -module Language.OCaml.Parser.SingleAttrId - ( singleAttrIdP - ) where - -import Text.Megaparsec - -import Language.OCaml.Parser.Tokens -import Language.OCaml.Parser.Utils.Types - -singleAttrIdP :: Parser String -singleAttrIdP = choice - [ lIdentT - , uIdentT - -- TODO - ] diff --git a/lib/Language/OCaml/Parser/StrExceptionDeclaration.hs b/lib/Language/OCaml/Parser/StrExceptionDeclaration.hs deleted file mode 100644 --- a/lib/Language/OCaml/Parser/StrExceptionDeclaration.hs +++ /dev/null @@ -1,15 +0,0 @@ -module Language.OCaml.Parser.StrExceptionDeclaration - ( strExceptionDeclarationP - ) where - -import Text.Megaparsec - -import Language.OCaml.Definitions.Parsing.ParseTree -import Language.OCaml.Parser.SigExceptionDeclaration -import Language.OCaml.Parser.Utils.Types - -strExceptionDeclarationP :: Parser Structure -> Parser (ExtensionConstructor, ()) -strExceptionDeclarationP structureP = choice - [ sigExceptionDeclarationP structureP - -- TODO - ] diff --git a/lib/Language/OCaml/Parser/StrictBinding.hs b/lib/Language/OCaml/Parser/StrictBinding.hs deleted file mode 100644 --- a/lib/Language/OCaml/Parser/StrictBinding.hs +++ /dev/null @@ -1,24 +0,0 @@ -module Language.OCaml.Parser.StrictBinding - ( strictBindingP - ) where - -import Text.Megaparsec - -import Language.OCaml.Definitions.Parsing.ParseTree -import Language.OCaml.Parser.Common -import Language.OCaml.Parser.LabeledSimplePattern -import Language.OCaml.Parser.Pattern -import Language.OCaml.Parser.Tokens -import Language.OCaml.Parser.Utils.Types - -strictBindingP :: Parser Expression -> Parser Expression -> Parser Expression -strictBindingP seqExprP funBindingP = choice - [ do - try $ equalT - seqExprP - , do - (l, o, p) <- labeledSimplePatternP patternP - b <- funBindingP - return $ ghexp $ PexpFun l o p b - -- TODO - ] diff --git a/lib/Language/OCaml/Parser/Structure.hs b/lib/Language/OCaml/Parser/Structure.hs deleted file mode 100644 --- a/lib/Language/OCaml/Parser/Structure.hs +++ /dev/null @@ -1,39 +0,0 @@ -module Language.OCaml.Parser.Structure - ( structureP - ) where - -import Text.Megaparsec - -import Language.OCaml.Definitions.Parsing.ParseTree -import Language.OCaml.Parser.Common -import Language.OCaml.Parser.PostItemAttributes -import Language.OCaml.Parser.SeqExpr -import Language.OCaml.Parser.StructureItem -import Language.OCaml.Parser.Tokens -import Language.OCaml.Parser.Utils.Utils -import Language.OCaml.Parser.Utils.Types - -structureP :: Parser Structure -structureP = ocamlSpace *> choice - [ do - e <- seqExprP structureP - a <- postItemAttributesP structureP - s <- structureTailP - return $ textStr 1 ++ mkstrexp e a : s - , structureTailP - ] - where - structureTailP :: Parser [StructureItem] - structureTailP = choice - [ do - (i, t) <- try $ do - i <- structureItemP structureP - t <- structureTailP - return (i, t) - return $ textStr 1 ++ i : t - , do - try $ semiSemiT - s <- structureP - return $ textStr 1 ++ s - , ocamlSpace *> return [] - ] diff --git a/lib/Language/OCaml/Parser/StructureItem.hs b/lib/Language/OCaml/Parser/StructureItem.hs deleted file mode 100644 --- a/lib/Language/OCaml/Parser/StructureItem.hs +++ /dev/null @@ -1,32 +0,0 @@ -module Language.OCaml.Parser.StructureItem - ( structureItemP - ) where - -import Text.Megaparsec - -import Language.OCaml.Definitions.Parsing.ParseTree -import Language.OCaml.Parser.Common -import Language.OCaml.Parser.LetBindings -import Language.OCaml.Parser.ModuleBinding -import Language.OCaml.Parser.OpenStatement -import Language.OCaml.Parser.SeqExpr -import Language.OCaml.Parser.StrExceptionDeclaration -import Language.OCaml.Parser.TypeDeclarations -import Language.OCaml.Parser.Utils.Types - -structureItemP :: Parser Structure -> Parser StructureItem -structureItemP structureP = choice - [ valOfLetBindings <$> letBindingsP structureP (seqExprP structureP) - , do - (nr, l) <- typeDeclarationsP structureP - return $ mkstrExt (PstrType nr (reverse l)) Nothing -- FIXME: not Nothing - , do - (l, _ext) <- strExceptionDeclarationP structureP - return $ mkstrExt (PstrException l) Nothing -- FIXME - , do - (body, _ext) <- openStatementP structureP - return $ mkstrExt (PstrOpen body) Nothing -- FIXME - , do - (body, _ext) <- moduleBindingP structureP - return $ mkstrExt (PstrModule body) Nothing -- FIXME - ] diff --git a/lib/Language/OCaml/Parser/Tokens.hs b/lib/Language/OCaml/Parser/Tokens.hs deleted file mode 100644 --- a/lib/Language/OCaml/Parser/Tokens.hs +++ /dev/null @@ -1,322 +0,0 @@ -module Language.OCaml.Parser.Tokens - ( andT - , asT - , atT - , bangT - , barT - , barRBracketT - , caretT - , charT - , colonT - , colonColonT - , colonGreaterT - , commaT - , dotT - , elseT - , equalT - , exceptionT - , falseT - , funT - , functionT - , greaterT - , ifT - , inT - , intT - , lBraceT - , lBracketT - , lBracketAtT - , lBracketAtAtT - , lBracketBarT - , lIdentT - , lParenT - , letT - , matchT - , minusT - , minusGreaterT - , moduleT - , mutableT - , nonrecT - , ofT - , openT - , plusT - , privateT - , quoteT - , rBraceT - , rBracketT - , rParenT - , recT - , semiT - , semiSemiT - , starT - , stringT - , thenT - , trueT - , typeT - , uIdentT - , underscoreT - , whenT - , withT - ) where - -import Data.Char -import Text.Megaparsec -import Text.Megaparsec.Char - -import Language.OCaml.Parser.Utils.Utils -import Language.OCaml.Parser.Utils.Types - -andT :: Parser () -andT = rword "and" - -asT :: Parser () -asT = rword "as" - -atT :: Parser () -atT = symbol "@" - -bangT :: Parser () -bangT = symbol "!" - -barT :: Parser () -barT = symbol "|" - -barRBracketT :: Parser () -barRBracketT = symbol "|]" - -binDigitChar :: Parser Char -binDigitChar = char '0' <|> char '1' - -binLiteralP :: Parser String -binLiteralP = do -- WARNING: do not add `lexeme` here - _ <- char '0' - _ <- char 'b' <|> char 'B' - h <- binDigitChar - t <- many (binDigitChar <|> char '_') - return $ h : t - -caretT :: Parser () -caretT = symbol "^" - -charT :: Parser Char -charT = do - symbol "'" - c <- satisfy (not . (`elem` ['\\', '\'', '\010', '\013'])) - symbol "'" - return c - -colonT :: Parser () -colonT = symbol ":" - -colonColonT :: Parser () -colonColonT = symbol "::" - -colonGreaterT :: Parser () -colonGreaterT = symbol ":>" - -commaT :: Parser () -commaT = symbol "," - -decimalLiteralP :: Parser String -decimalLiteralP = do -- WARNING: do not add `lexeme` here - h <- digitChar - t <- many (digitChar <|> char '_') - return $ h : t - -dotT :: Parser () -dotT = symbol "." - -elseT :: Parser () -elseT = rword "else" - -equalT :: Parser () -equalT = symbol "=" - -falseT :: Parser () -falseT = rword "false" - -funT :: Parser () -funT = rword "fun" - -functionT :: Parser () -functionT = rword "function" - -ifT :: Parser () -ifT = rword "if" - -exceptionT :: Parser () -exceptionT = rword "exception" - -greaterT :: Parser () -greaterT = symbol ">" - -hexLiteralP :: Parser String -hexLiteralP = do -- WARNING: do not add `lexeme` here - _ <- char '0' - _ <- char 'x' <|> char 'X' - h <- hexDigitChar - t <- many (hexDigitChar <|> char '_') - return $ h : t - -intLiteralP :: Parser String -intLiteralP = choice - [ decimalLiteralP - , hexLiteralP - , octLiteralP - , binLiteralP - ] - -inT :: Parser () -inT = rword "in" - -intT :: Parser (String, Maybe Char) -intT = lexeme $ do - l <- intLiteralP - m <- choice - [ Just <$> literalModifierP - , return Nothing - ] - return (l, m) - -isBetween :: Char -> Char -> Char -> Bool -isBetween cmin c cmax = (vmin <= v && v <= vmax) - where - vmin = conv cmin - v = conv c - vmax = conv cmax - conv = ord - -isModifier :: Char -> Bool -isModifier c = isBetween 'G' c 'Z' || isBetween 'g' c 'z' - -literalModifierP :: Parser Char -literalModifierP = satisfy isModifier - -identCharT :: Parser Char -identCharT = choice - [ upperChar - , lowerChar - , char '_' - , char '\'' - , digitChar - ] - -lBraceT :: Parser () -lBraceT = symbol "{" - -lBracketT :: Parser () -lBracketT = symbol "[" - -lBracketAtT :: Parser () -lBracketAtT = symbol "[@" - -lBracketAtAtT :: Parser () -lBracketAtAtT = symbol "[@@" - -lBracketBarT :: Parser () -lBracketBarT = symbol "[|" - -lIdentT :: Parser String -lIdentT = identifier $ do - c <- lowerChar - cs <- many identCharT - return $ c : cs - -lParenT :: Parser () -lParenT = symbol "(" - -letT :: Parser () -letT = rword "let" - -matchT :: Parser () -matchT = rword "match" - -minusT :: Parser () -minusT = symbol "-" - -minusGreaterT :: Parser () -minusGreaterT = symbol "->" - -moduleT :: Parser () -moduleT = rword "module" - -mutableT :: Parser () -mutableT = rword "mutable" - -nonrecT :: Parser () -nonrecT = rword "nonrec" - -octLiteralP :: Parser String -octLiteralP = do -- WARNING: do not add `lexeme` here - _ <- char '0' - _ <- char 'o' <|> char 'O' - h <- octDigitChar - t <- many (octDigitChar <|> char '_') - return $ h : t - -ofT :: Parser () -ofT = rword "of" - -openT :: Parser () -openT = rword "open" - -plusT :: Parser () -plusT = symbol "+" - -privateT :: Parser () -privateT = rword "private" - -quoteT :: Parser () -quoteT = symbol "'" - -rBraceT :: Parser () -rBraceT = symbol "}" - -rBracketT :: Parser () -rBracketT = symbol "]" - -rParenT :: Parser () -rParenT = symbol ")" - -recT :: Parser () -recT = rword "rec" - -semiT :: Parser () -semiT = symbol ";" - -semiSemiT :: Parser () -semiSemiT = symbol ";;" - -starT :: Parser () -starT = symbol "*" - --- FIXME: real strings have nesting comments and escape characters -stringT :: Parser (String, Maybe String) -stringT = lexeme $ do - _ <- char '"' - s <- many $ satisfy ((/=) '"') - _ <- char '"' - return (s, Nothing) - -thenT :: Parser () -thenT = rword "then" - -trueT :: Parser () -trueT = rword "true" - -typeT :: Parser () -typeT = rword "type" - -uIdentT :: Parser String -uIdentT = identifier $ do - c <- upperChar - cs <- many identCharT - return $ c : cs - -underscoreT :: Parser () -underscoreT = symbol "_" - -whenT :: Parser () -whenT = rword "when" - -withT :: Parser () -withT = rword "with" diff --git a/lib/Language/OCaml/Parser/TypeConstraint.hs b/lib/Language/OCaml/Parser/TypeConstraint.hs deleted file mode 100644 --- a/lib/Language/OCaml/Parser/TypeConstraint.hs +++ /dev/null @@ -1,30 +0,0 @@ -module Language.OCaml.Parser.TypeConstraint - ( typeConstraintP - ) where - -import Text.Megaparsec - -import Language.OCaml.Definitions.Parsing.ParseTree -import Language.OCaml.Parser.CoreType -import Language.OCaml.Parser.Tokens -import Language.OCaml.Parser.Utils.Types - -typeConstraintP :: Parser (Maybe CoreType, Maybe CoreType) -typeConstraintP = choice - [ do - t1 <- try $ do - colonT - t1 <- coreTypeP - colonGreaterT - return t1 - t2 <- coreTypeP - return (Just t1, Just t2) - , try $ do - colonT - t <- coreTypeP - return (Just t, Nothing) - , do - try $ colonGreaterT - t <- coreTypeP - return (Nothing, Just t) - ] diff --git a/lib/Language/OCaml/Parser/TypeDeclaration.hs b/lib/Language/OCaml/Parser/TypeDeclaration.hs deleted file mode 100644 --- a/lib/Language/OCaml/Parser/TypeDeclaration.hs +++ /dev/null @@ -1,34 +0,0 @@ -{-# LANGUAGE DisambiguateRecordFields #-} -{-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE NamedFieldPuns #-} - -module Language.OCaml.Parser.TypeDeclaration - ( typeDeclarationP - ) where - -import Data.Default -import Text.Megaparsec - -import Language.OCaml.Definitions.Parsing.ASTHelper.Type as Type -import qualified Language.OCaml.Definitions.Parsing.ASTTypes as ASTTypes -import Language.OCaml.Definitions.Parsing.ParseTree -import Language.OCaml.Parser.Common -import Language.OCaml.Parser.NonRecFlag -import Language.OCaml.Parser.OptionalTypeParameters -import Language.OCaml.Parser.PostItemAttributes -import Language.OCaml.Parser.Tokens -import Language.OCaml.Parser.TypeKind -import Language.OCaml.Parser.Utils.Types - -typeDeclarationP :: Parser Structure -> Parser (ASTTypes.RecFlag, TypeDeclaration) -typeDeclarationP structureP = do - try $ typeT - -- TODO: extAttributes - nonrecFlag <- nonrecFlagP - params <- optionalTypeParametersP - n <- lIdentT - (kind, priv, manifest) <- typeKindP structureP - -- TODO: constraints - attrs <- postItemAttributesP structureP - let ty = Type.mk (def { attrs, kind, params, priv }) manifest (mkRHS n 5) - return (nonrecFlag, ty) diff --git a/lib/Language/OCaml/Parser/TypeDeclarations.hs b/lib/Language/OCaml/Parser/TypeDeclarations.hs deleted file mode 100644 --- a/lib/Language/OCaml/Parser/TypeDeclarations.hs +++ /dev/null @@ -1,25 +0,0 @@ -module Language.OCaml.Parser.TypeDeclarations - ( typeDeclarationsP - ) where - -import qualified Language.OCaml.Definitions.Parsing.ASTTypes as ASTTypes -import Language.OCaml.Definitions.Parsing.ParseTree -import Language.OCaml.Parser.AndTypeDeclaration -import Language.OCaml.Parser.TypeDeclaration -import Language.OCaml.Parser.Utils.Combinators -import Language.OCaml.Parser.Utils.Types - -typeDeclarationsP :: - Parser Structure -> Parser (ASTTypes.RecFlag, [TypeDeclaration]) -typeDeclarationsP structureP = leftRecursive - [ do - (nonrecFlag, ty) <- typeDeclarationP' - return $ (nonrecFlag, [ty]) - ] - [ do - ty <- andTypeDeclarationP' - return $ \ (nonrecFlag, tys) -> (nonrecFlag, ty : tys) - ] - where - typeDeclarationP' = typeDeclarationP structureP - andTypeDeclarationP' = andTypeDeclarationP structureP diff --git a/lib/Language/OCaml/Parser/TypeKind.hs b/lib/Language/OCaml/Parser/TypeKind.hs deleted file mode 100644 --- a/lib/Language/OCaml/Parser/TypeKind.hs +++ /dev/null @@ -1,40 +0,0 @@ -module Language.OCaml.Parser.TypeKind - ( typeKindP - ) where - -import Text.Megaparsec - -import Language.OCaml.Definitions.Parsing.ParseTree -import Language.OCaml.Parser.ConstructorDeclarations -import Language.OCaml.Parser.CoreType -import Language.OCaml.Parser.LabelDeclarations -import Language.OCaml.Parser.PrivateFlag -import Language.OCaml.Parser.Tokens -import Language.OCaml.Parser.Utils.Types - -typeKindP :: Parser Structure -> Parser (TypeKind, PrivateFlag, Maybe CoreType) -typeKindP structureP = choice - [ do - t <- try $ do - equalT - coreTypeP - return (PtypeAbstract, Public, Just t) - , do - cs <- try $ do - equalT - constructorDeclarationsP' - return (PtypeVariant (reverse cs), Private, Nothing) - , do - priv <- try $ do - equalT - priv <- privateFlagP - lBraceT - return priv - labels <- labelDeclarationsP - rBraceT - return (PtypeRecord labels, priv, Nothing) - -- FIXME: commenting this out as it helps with debugging, but this is a valid parse of type kind - -- , return (PtypeAbstract, Public, Nothing) - ] - where - constructorDeclarationsP' = constructorDeclarationsP structureP coreTypeP diff --git a/lib/Language/OCaml/Parser/TypeLongident.hs b/lib/Language/OCaml/Parser/TypeLongident.hs deleted file mode 100644 --- a/lib/Language/OCaml/Parser/TypeLongident.hs +++ /dev/null @@ -1,20 +0,0 @@ -module Language.OCaml.Parser.TypeLongident - ( typeLongidentP - ) where - -import Text.Megaparsec - -import Language.OCaml.Definitions.Parsing.ParseTree -import Language.OCaml.Parser.ModExtLongident -import Language.OCaml.Parser.Tokens -import Language.OCaml.Parser.Utils.Types - -typeLongidentP :: Parser Longident -typeLongidentP = choice - [ Lident <$> lIdentT - , do - p <- modExtLongidentP - dotT - i <- lIdentT - return $ Ldot p i - ] diff --git a/lib/Language/OCaml/Parser/TypeVariable.hs b/lib/Language/OCaml/Parser/TypeVariable.hs deleted file mode 100644 --- a/lib/Language/OCaml/Parser/TypeVariable.hs +++ /dev/null @@ -1,12 +0,0 @@ -module Language.OCaml.Parser.TypeVariable - ( typeVariableP - ) where - - -import Language.OCaml.Definitions.Parsing.ParseTree -import Language.OCaml.Parser.Common -import Language.OCaml.Parser.Tokens -import Language.OCaml.Parser.Utils.Types - -typeVariableP :: Parser CoreType -typeVariableP = mktyp . PtypVar <$> (quoteT *> identP) diff --git a/lib/Language/OCaml/Parser/TypeVariance.hs b/lib/Language/OCaml/Parser/TypeVariance.hs deleted file mode 100644 --- a/lib/Language/OCaml/Parser/TypeVariance.hs +++ /dev/null @@ -1,16 +0,0 @@ -module Language.OCaml.Parser.TypeVariance - ( typeVarianceP - ) where - -import Text.Megaparsec - -import Language.OCaml.Definitions.Parsing.ASTTypes -import Language.OCaml.Parser.Tokens -import Language.OCaml.Parser.Utils.Types - -typeVarianceP :: Parser Variance -typeVarianceP = choice - [ plusT *> pure Covariant - , minusT *> pure Contravariant - , pure Invariant - ] diff --git a/lib/Language/OCaml/Parser/Utils/Combinators.hs b/lib/Language/OCaml/Parser/Utils/Combinators.hs deleted file mode 100644 --- a/lib/Language/OCaml/Parser/Utils/Combinators.hs +++ /dev/null @@ -1,77 +0,0 @@ -module Language.OCaml.Parser.Utils.Combinators - ( chainl1 - , chainl1' - , chainl1try - , chainl1try' - , leftRecursive - ) where - -import Control.Applicative -import Text.Megaparsec - -import Language.OCaml.Parser.Utils.Types - -{- - -This combinator is necessary because we want to parse succesfully even when -the `op` is not part of the chain. - -For instance, in OCaml, a modLongident is a sequence of `Foo.Bar.Baz` and must -be parsed as a chain. However, when presented with `Foo.Bar.baz`, we'd like the -chain to capture `Foo.Bar` and ignore the `.baz`. - --} -chainl1try' :: Parser a -> Parser (b -> a -> b) -> (a -> b) -> Parser b -chainl1try' p op bc = p >>= rest . bc - where - rest x = tryOp x <|> return x - tryOp x = try $ do - f <- op - y <- p - rest (f x y) - -chainl1try :: Parser b -> Parser (b -> b -> b) -> Parser b -chainl1try p op = chainl1try' p op id - -chainl1' :: (Alternative m, Monad m) => m a -> m (b -> a -> b) -> (a -> b) -> m b -chainl1' p op bc = p >>= rest . bc - where - rest x = do { f <- op ; y <- p ; rest (f x y) } <|> return x - -chainl1 :: (Alternative m, Monad m) => m a -> m (a -> a -> a) -> m a -chainl1 p op = chainl1' p op id - -{- - -This applies the procedure of turning a left-recursive grammar into a -non-left-recursive one. Essentially, when wanting to write the grammar: - -A ::= -| A B { foo A B } -| C { bar C } - -One instead writes the following: - -A' ::= -| C R { R (bar C) } - -R ::= -| B R { \ A -> R (foo A B) } -| {-empty-} { id } - -The two arguments to `leftRecursive` are the grammars for A' and R (except the -last line of R is not needed, but added by the combinator). - --} -leftRecursive :: (Monad m, Alternative m) => [m a] -> [m (a -> a)] -> m a -leftRecursive prefixes suffixes = choice $ map patchPrefix prefixes - where - patchPrefix prefixP = do - p <- prefixP - r <- rest - return $ r p - patchSuffix suffixP = do - s <- suffixP - r <- rest - return $ r . s - rest = choice $ map patchSuffix suffixes ++ [ return id ] diff --git a/lib/Language/OCaml/Parser/Utils/Types.hs b/lib/Language/OCaml/Parser/Utils/Types.hs deleted file mode 100644 --- a/lib/Language/OCaml/Parser/Utils/Types.hs +++ /dev/null @@ -1,8 +0,0 @@ -module Language.OCaml.Parser.Utils.Types - ( Parser - ) where - -import Data.Void -import Text.Megaparsec - -type Parser = Parsec Void String diff --git a/lib/Language/OCaml/Parser/Utils/Utils.hs b/lib/Language/OCaml/Parser/Utils/Utils.hs deleted file mode 100644 --- a/lib/Language/OCaml/Parser/Utils/Utils.hs +++ /dev/null @@ -1,115 +0,0 @@ -module Language.OCaml.Parser.Utils.Utils - -- , checkIdentifier - ( identifier - , lexeme - , ocamlSpace - , parens - , rword - , symbol - ) where - -import Data.Functor -import Text.Megaparsec -import Text.Megaparsec.Char -import qualified Text.Megaparsec.Char.Lexer as L -import Text.Printf - -import Language.OCaml.Parser.Utils.Types - -checkIdentifier :: String -> Parser String -checkIdentifier c = - if c `elem` reservedWords - then fail $ printf "keyword %s cannot be an identifier" (show c) - else return c - -identifier :: Parser String -> Parser String -identifier p = (lexeme . try) (p >>= checkIdentifier) - --- identifier :: Parser String --- identifier = (lexeme . try) (p >>= checkIdentifier) --- where --- p = (:) <$> letterChar <*> many (alphaNumChar <|> char '_') - -ocamlSpace :: Parser () -ocamlSpace = L.space (void spaceChar) lineCmnt blockCmnt - where - lineCmnt = L.skipLineComment "//" - blockCmnt = L.skipBlockComment "(*" "*)" - -lexeme :: Parser a -> Parser a -lexeme = L.lexeme ocamlSpace - -parens :: Parser a -> Parser a -parens = between (symbol "(") (symbol ")") - -rword :: String -> Parser () -rword w = - if w `elem` reservedWords - then string w *> notFollowedBy alphaNumChar *> ocamlSpace - else error - $ "The following word must be added to reservedWords in Language.OCaml.Parser.Utils.Utils: " - ++ w - -symbol :: String -> Parser () -symbol = void . L.symbol ocamlSpace - -reservedWords :: [String] -- list of reserved words -reservedWords = - [ "and" - , "as" - , "assert" - , "begin" - , "class" - , "constraint" - , "do" - , "done" - , "downto" - , "else" - , "end" - , "exception" - , "external" - , "false" - , "for" - , "fun" - , "function" - , "functor" - , "if" - , "in" - , "include" - , "inherit" - , "initializer" - , "lazy" - , "let" - , "match" - , "method" - , "module" - , "mutable" - , "new" - , "nonrec" - , "object" - , "of" - , "open" - , "or" - -- , "parser" - , "private" - , "rec" - , "sig" - , "struct" - , "then" - , "to" - , "true" - , "try" - , "type" - , "val" - , "virtual" - , "when" - , "while" - , "with" - , "lor" - , "lxor" - , "mod" - , "land" - , "lsl" - , "lsr" - , "asr" - ] diff --git a/lib/Language/OCaml/Parser/ValIdent.hs b/lib/Language/OCaml/Parser/ValIdent.hs deleted file mode 100644 --- a/lib/Language/OCaml/Parser/ValIdent.hs +++ /dev/null @@ -1,20 +0,0 @@ -module Language.OCaml.Parser.ValIdent - ( valIdentP - ) where - -import Text.Megaparsec - -import Language.OCaml.Parser.Operator -import Language.OCaml.Parser.Tokens -import Language.OCaml.Parser.Utils.Types - -valIdentP :: Parser String -valIdentP = choice - [ lIdentT - , do - o <- try $ do - lParenT - operatorP - rParenT - return o - ] diff --git a/lib/Language/OCaml/Parser/ValLongident.hs b/lib/Language/OCaml/Parser/ValLongident.hs deleted file mode 100644 --- a/lib/Language/OCaml/Parser/ValLongident.hs +++ /dev/null @@ -1,23 +0,0 @@ -module Language.OCaml.Parser.ValLongident - ( valLongidentP - ) where - -import Text.Megaparsec - -import Language.OCaml.Definitions.Parsing.ParseTree -import Language.OCaml.Parser.ModLongident -import Language.OCaml.Parser.Tokens -import Language.OCaml.Parser.Utils.Types -import Language.OCaml.Parser.ValIdent - -valLongidentP :: Parser Longident -valLongidentP = choice - [ Lident <$> valIdentP - , do - l <- try $ do - l <- modLongidentP - dotT - return l - i <- valIdentP - return $ Ldot l i - ] diff --git a/lib/Language/OCaml/PrettyPrinter.hs b/lib/Language/OCaml/PrettyPrinter.hs --- a/lib/Language/OCaml/PrettyPrinter.hs +++ b/lib/Language/OCaml/PrettyPrinter.hs @@ -1,10 +1,24 @@ module Language.OCaml.PrettyPrinter ( pretty + , payloadPP , structurePP + , structureItemPP ) where -import Data.Text.Prettyprint.Doc (pretty) +import Data.Text.Prettyprint.Doc (Doc, pretty) -import Language.OCaml.PrettyPrinter.Payload () -import Language.OCaml.PrettyPrinter.Structure -import Language.OCaml.PrettyPrinter.StructureItem () +import Language.OCaml.Definitions.Parsing.ParseTree +import qualified Language.OCaml.PrettyPrinter.Payload as Payload +import qualified Language.OCaml.PrettyPrinter.Structure as Structure +import qualified Language.OCaml.PrettyPrinter.StructureItem as StructureItem + +-- tying some knots + +payloadPP :: Payload -> Doc a +payloadPP = Payload.payloadPP + +structureItemPP :: StructureItem -> Doc a +structureItemPP = StructureItem.structureItemPP + +structurePP :: Structure -> Doc a +structurePP = Structure.structurePP diff --git a/lib/Language/OCaml/PrettyPrinter/Structure.hs b/lib/Language/OCaml/PrettyPrinter/Structure.hs --- a/lib/Language/OCaml/PrettyPrinter/Structure.hs +++ b/lib/Language/OCaml/PrettyPrinter/Structure.hs @@ -9,5 +9,5 @@ import Language.OCaml.Definitions.Parsing.ParseTree import Language.OCaml.PrettyPrinter.StructureItem () -structurePP :: (Pretty Payload) => Structure -> Doc a +structurePP :: Pretty Payload => Structure -> Doc a structurePP = vcat . map pretty diff --git a/test/Language/OCaml/Parser/Common/Test.hs b/test/Language/OCaml/Parser/Common/Test.hs deleted file mode 100644 --- a/test/Language/OCaml/Parser/Common/Test.hs +++ /dev/null @@ -1,52 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE QuasiQuotes #-} - -module Language.OCaml.Parser.Common.Test - ( test - , unitTests - ) where - -import Test.Tasty - -import Language.OCaml.Parser.Internal -import Language.OCaml.Parser.TestUtils - -constrIdentTests :: [String] -constrIdentTests = - [ "A" - , "Ab" - , "AB" - , "[]" - , "false" - , "true" - , "A " - , "Ab " - , "AB " - , "[] " - , "false " - , "true " - ] - -identTests :: [String] -identTests = - [ "A" - , "Ab" - , "AB" - , "a" - , "aB" - , "ab" - , "A " - , "Ab " - , "AB " - , "a " - , "aB " - , "ab " - ] - -unitTests :: TestTree -unitTests = testGroup "Language.OCaml.Parser.Common" $ [] - ++ map (mkParsingTest "constrIdentP" constrIdentP) constrIdentTests - ++ map (mkParsingTest "identP" identP) identTests - -test :: IO () -test = defaultMain unitTests diff --git a/test/Language/OCaml/Parser/Constant/Test.hs b/test/Language/OCaml/Parser/Constant/Test.hs --- a/test/Language/OCaml/Parser/Constant/Test.hs +++ b/test/Language/OCaml/Parser/Constant/Test.hs @@ -1,16 +1,8 @@ -{-# LANGUAGE OverloadedStrings #-} - module Language.OCaml.Parser.Constant.Test - ( test - , testStrings - , unitTests + ( testStrings ) where -import Test.Tasty - -import Language.OCaml.Parser.Internal import qualified Language.OCaml.Parser.Int.Test as Int -import Language.OCaml.Parser.TestUtils testStrings :: [String] testStrings = [] @@ -18,10 +10,3 @@ -- TODO: CHAR -- TODO: STRING -- TODO: FLOAT - -unitTests :: TestTree -unitTests = testGroup "Language.OCaml.Parser.Constant" $ [] - ++ map (mkParsingTest "valLongIdentP" valLongidentP) testStrings - -test :: IO () -test = defaultMain unitTests diff --git a/test/Language/OCaml/Parser/ConstrLongident/Test.hs b/test/Language/OCaml/Parser/ConstrLongident/Test.hs --- a/test/Language/OCaml/Parser/ConstrLongident/Test.hs +++ b/test/Language/OCaml/Parser/ConstrLongident/Test.hs @@ -1,17 +1,12 @@ {-# LANGUAGE QuasiQuotes #-} module Language.OCaml.Parser.ConstrLongident.Test - ( test - , testStrings - , unitTests + ( testStrings ) where -import Data.String.Interpolate -import Test.Tasty +import Data.String.Interpolate -import Language.OCaml.Parser.Internal import qualified Language.OCaml.Parser.ModLongident.Test as ModLongident -import Language.OCaml.Parser.TestUtils testStrings :: [String] testStrings = [] @@ -25,10 +20,3 @@ , "false" , "true" ] - -unitTests :: TestTree -unitTests = testGroup "Language.OCaml.Parser.ConstrLongident" $ [] - ++ map (mkParsingTest "constrLongidentP" constrLongidentP) testStrings - -test :: IO () -test = defaultMain unitTests diff --git a/test/Language/OCaml/Parser/CoreType/Test.hs b/test/Language/OCaml/Parser/CoreType/Test.hs new file mode 100644 --- /dev/null +++ b/test/Language/OCaml/Parser/CoreType/Test.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE QuasiQuotes #-} + +module Language.OCaml.Parser.CoreType.Test + ( testStrings + ) where + +-- import Data.String.Interpolate + +import qualified Language.OCaml.Parser.CoreTypeNoAttr.Test as CoreTypeNoAttr + +testStrings :: [String] +testStrings = [] + ++ coreTypeNoAttr + -- TODO + where + coreTypeNoAttr = CoreTypeNoAttr.testStrings diff --git a/test/Language/OCaml/Parser/CoreType2/Test.hs b/test/Language/OCaml/Parser/CoreType2/Test.hs new file mode 100644 --- /dev/null +++ b/test/Language/OCaml/Parser/CoreType2/Test.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE QuasiQuotes #-} + +module Language.OCaml.Parser.CoreType2.Test + ( testStrings + ) where + +-- import Data.String.Interpolate + +import qualified Language.OCaml.Parser.SimpleCoreTypeOrTuple.Test as SimpleCoreTypeOrTuple + +testStrings :: [String] +testStrings = [] + ++ simpleCoreTypeOrTuple + -- TODO + where + simpleCoreTypeOrTuple = SimpleCoreTypeOrTuple.testStrings diff --git a/test/Language/OCaml/Parser/CoreTypeNoAttr/Test.hs b/test/Language/OCaml/Parser/CoreTypeNoAttr/Test.hs new file mode 100644 --- /dev/null +++ b/test/Language/OCaml/Parser/CoreTypeNoAttr/Test.hs @@ -0,0 +1,22 @@ +{-# LANGUAGE QuasiQuotes #-} + +module Language.OCaml.Parser.CoreTypeNoAttr.Test + ( testStrings + ) where + +import Data.String.Interpolate +import Prelude hiding (id) + +import qualified Language.OCaml.Parser.CoreType2.Test as CoreType2 +import qualified Language.OCaml.Parser.Ident.Test as Ident + +testStrings :: [String] +testStrings = [] + ++ coreType2 + ++ [ [i| #{ct2} as '#{id} |] + | ct2 <- coreType2 + , id <- ident + ] + where + coreType2 = CoreType2.testStrings + ident = Ident.testStrings diff --git a/test/Language/OCaml/Parser/Generator/Expr/Test.hs b/test/Language/OCaml/Parser/Generator/Expr/Test.hs --- a/test/Language/OCaml/Parser/Generator/Expr/Test.hs +++ b/test/Language/OCaml/Parser/Generator/Expr/Test.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE QuasiQuotes #-} - module Language.OCaml.Parser.Generator.Expr.Test ( test , unitTests @@ -13,7 +11,7 @@ unitTests :: TestTree unitTests = testGroup "Language.OCaml.Parser.Generator.Expr" $ [] - ++ map (mkParsingTestG parseExpr) TestStrings.expr + ++ map (mkParsingTest parseExpr) TestStrings.expr test :: IO () test = defaultMain unitTests diff --git a/test/Language/OCaml/Parser/Generator/Implementation/Test.hs b/test/Language/OCaml/Parser/Generator/Implementation/Test.hs --- a/test/Language/OCaml/Parser/Generator/Implementation/Test.hs +++ b/test/Language/OCaml/Parser/Generator/Implementation/Test.hs @@ -2,63 +2,24 @@ module Language.OCaml.Parser.Generator.Implementation.Test ( test - , unitTests + , mkUnitTest ) where --- import Data.String.QQ import Test.Tasty --- import Language.OCaml.Parser.Generator.Lexer +import Language.OCaml.Definitions.Parsing.ParseTree import Language.OCaml.Parser.Generator.Parser -import Language.OCaml.Parser.TestUtils -import Language.OCaml.Parser.Implementation.Test (testFiles) - --- prefix :: FilePath --- prefix = "test/ocaml/" - --- mlFiles :: [String] --- mlFiles = [] --- ++ map (prefix ++) --- [ "typing/typetexp.ml" --- , "typing/path.ml" --- , "typing/includecore.ml" --- , "typing/printtyped.ml" --- , "typing/typedecl.ml" --- , "typing/btype.ml" --- , "typing/typemod.ml" --- , "typing/tast_mapper.ml" --- , "typing/subst.ml" --- , "typing/typecore.ml" --- , "typing/datarepr.ml" --- , "typing/typedtree.ml" --- , "typing/untypeast.ml" --- , "typing/parmatch.ml" --- , "typing/ident.ml" --- , "typing/cmt_format.ml" --- , "typing/oprint.ml" --- , "typing/env.ml" --- , "typing/stypes.ml" --- , "typing/includemod.ml" --- , "typing/includeclass.ml" --- , "typing/primitive.ml" --- , "typing/envaux.ml" --- , "typing/typeclass.ml" --- , "typing/cmi_format.ml" --- , "typing/printtyp.ml" --- , "typing/mtype.ml" --- , "typing/types.ml" --- , "typing/typedtreeIter.ml" --- , "typing/typedtreeMap.ml" --- , "typing/typeopt.ml" --- , "typing/printpat.ml" --- , "typing/predef.ml" --- , "typing/ctype.ml" --- ] +import Language.OCaml.Parser.Implementation.Test -unitTests :: TestTree -unitTests = testGroup "Language.OCaml.Parser.Generator.Implementation" $ [] - ++ map (mkParsingTestFromFileG parseImplementation) testFiles - -- ++ map (mkParsingTestFromFileG parseImplementation) mlFiles +mkUnitTest :: [FilePath] -> TestTree +mkUnitTest fileNames = + testGroup "Language.OCaml.Parser.Generator.Implementation" $ [] + ++ map testMLFile fileNames test :: IO () -test = defaultMain unitTests +test = do + mlFiles <- listMLFiles + defaultMain $ mkUnitTest mlFiles + +debug :: Either String [StructureItem] +debug = parseImplementation "let f x : b = c" diff --git a/test/Language/OCaml/Parser/Generator/LetBinding/Test.hs b/test/Language/OCaml/Parser/Generator/LetBinding/Test.hs new file mode 100644 --- /dev/null +++ b/test/Language/OCaml/Parser/Generator/LetBinding/Test.hs @@ -0,0 +1,17 @@ +module Language.OCaml.Parser.Generator.LetBinding.Test + ( test + , unitTests + ) where + +import Test.Tasty + +import Language.OCaml.Parser.Generator.Parser +import Language.OCaml.Parser.TestUtils +import qualified Language.OCaml.Parser.TestStrings as TestStrings + +unitTests :: TestTree +unitTests = testGroup "Language.OCaml.Parser.Generator.Structure" $ [] + ++ map (mkParsingTest parseLetBinding) TestStrings.letBinding + +test :: IO () +test = defaultMain unitTests diff --git a/test/Language/OCaml/Parser/Generator/SeqExpr/Test.hs b/test/Language/OCaml/Parser/Generator/SeqExpr/Test.hs --- a/test/Language/OCaml/Parser/Generator/SeqExpr/Test.hs +++ b/test/Language/OCaml/Parser/Generator/SeqExpr/Test.hs @@ -5,19 +5,15 @@ , unitTests ) where --- import Data.String.QQ -import Test.Tasty +import Test.Tasty --- import Language.OCaml.Parser.Generator.Lexer -import Language.OCaml.Parser.Generator.Parser --- import Language.OCaml.Parser.Internal -import Language.OCaml.Parser.TestUtils -import qualified Language.OCaml.Parser.TestStrings as TestStrings +import Language.OCaml.Parser.Generator.Parser +import Language.OCaml.Parser.TestUtils +import qualified Language.OCaml.Parser.TestStrings as TestStrings unitTests :: TestTree unitTests = testGroup "Language.OCaml.Parser.Generator.SeqExpr" $ [] - ++ map (mkParsingTestG parseSeqExpr) TestStrings.seqExpr - -- ++ map (compareParses "SeqExpr" seqExprP parseSeqExpr) testStrings + ++ map (mkParsingTest parseSeqExpr) TestStrings.seqExpr test :: IO () test = defaultMain unitTests diff --git a/test/Language/OCaml/Parser/Generator/SimpleExpr/Test.hs b/test/Language/OCaml/Parser/Generator/SimpleExpr/Test.hs --- a/test/Language/OCaml/Parser/Generator/SimpleExpr/Test.hs +++ b/test/Language/OCaml/Parser/Generator/SimpleExpr/Test.hs @@ -11,7 +11,7 @@ unitTests :: TestTree unitTests = testGroup "Language.OCaml.Parser.Generator.SimpleExpr" $ [] - ++ map (mkParsingTestG parseSimpleExpr) TestStrings.simpleExpr + ++ map (mkParsingTest parseSimpleExpr) TestStrings.simpleExpr test :: IO () test = defaultMain unitTests diff --git a/test/Language/OCaml/Parser/Generator/Structure/Test.hs b/test/Language/OCaml/Parser/Generator/Structure/Test.hs new file mode 100644 --- /dev/null +++ b/test/Language/OCaml/Parser/Generator/Structure/Test.hs @@ -0,0 +1,17 @@ +module Language.OCaml.Parser.Generator.Structure.Test + ( test + , unitTests + ) where + +import Test.Tasty + +import Language.OCaml.Parser.Generator.Parser +import Language.OCaml.Parser.TestUtils +import qualified Language.OCaml.Parser.TestStrings as TestStrings + +unitTests :: TestTree +unitTests = testGroup "Language.OCaml.Parser.Generator.Structure" $ [] + ++ map (mkParsingTest parseStructure) TestStrings.structure + +test :: IO () +test = defaultMain unitTests diff --git a/test/Language/OCaml/Parser/Generator/ValLongident/Test.hs b/test/Language/OCaml/Parser/Generator/ValLongident/Test.hs --- a/test/Language/OCaml/Parser/Generator/ValLongident/Test.hs +++ b/test/Language/OCaml/Parser/Generator/ValLongident/Test.hs @@ -11,7 +11,7 @@ unitTests :: TestTree unitTests = testGroup "Language.OCaml.Parser.Generator.ValLongident" $ [] - ++ map (mkParsingTestG parseValLongident) testStrings + ++ map (mkParsingTest parseValLongident) testStrings test :: IO () test = defaultMain unitTests diff --git a/test/Language/OCaml/Parser/Ident/Test.hs b/test/Language/OCaml/Parser/Ident/Test.hs new file mode 100644 --- /dev/null +++ b/test/Language/OCaml/Parser/Ident/Test.hs @@ -0,0 +1,19 @@ +module Language.OCaml.Parser.Ident.Test + ( testStrings + ) where + +testStrings :: [String] +testStrings = + [ "A" + , "Ab" + , "AB" + , "a" + , "aB" + , "ab" + , "A " + , "Ab " + , "AB " + , "a " + , "aB " + , "ab " + ] diff --git a/test/Language/OCaml/Parser/Implementation/Test.hs b/test/Language/OCaml/Parser/Implementation/Test.hs --- a/test/Language/OCaml/Parser/Implementation/Test.hs +++ b/test/Language/OCaml/Parser/Implementation/Test.hs @@ -1,45 +1,31 @@ {-# LANGUAGE QuasiQuotes #-} module Language.OCaml.Parser.Implementation.Test - ( test - , testFiles + ( debugLexer + , listMLFiles + , testMLFile , testStrings - , unitTests ) where --- import Data.String.QQ -import Test.Tasty +import Test.Tasty +import Test.Tasty.Golden -import Language.OCaml.Parser.Internal -import qualified Language.OCaml.Parser.Structure.Test as Structure --- import Language.OCaml.Parser.Tokens -import Language.OCaml.Parser.TestUtils +import Language.OCaml.Parser.Generator.Lexer +import Language.OCaml.Parser.Generator.Parser +import qualified Language.OCaml.Parser.Structure.Test as Structure +import Language.OCaml.Parser.TestUtils -prefix :: FilePath -prefix = "test/Language/OCaml/Parser/Implementation/" +directory :: FilePath +directory = "test/Language/OCaml/Parser/Implementation" testStrings :: [String] testStrings = Structure.testStrings -testFiles :: [FilePath] -testFiles = map (prefix ++) - [ "test_00.ml" - , "test_01.ml" - , "test_02.ml" - , "test_03.ml" - , "test_04.ml" - , "test_05.ml" - , "test_06.ml" - , "test_07.ml" - , "test_08.ml" - -- , "FaCT/tast.ml" - -- , "FaCT/tast-00.ml" - -- , "FaCT/tast-01.ml" - ] +listMLFiles :: IO [FilePath] +listMLFiles = findByExtension [".ml"] directory -unitTests :: TestTree -unitTests = testGroup "Language.OCaml.Parser.Generator.Implementation" $ [] - ++ map (mkParsingTestFromFile implementationP) testFiles +testMLFile :: FilePath -> TestTree +testMLFile fileName = mkParsingTestFromFile parseImplementation fileName -test :: IO () -test = defaultMain unitTests +debugLexer :: String -> Either String [ResultToken] +debugLexer = alexScanTokens diff --git a/test/Language/OCaml/Parser/Int/Test.hs b/test/Language/OCaml/Parser/Int/Test.hs --- a/test/Language/OCaml/Parser/Int/Test.hs +++ b/test/Language/OCaml/Parser/Int/Test.hs @@ -1,16 +1,7 @@ -{-# LANGUAGE OverloadedStrings #-} - module Language.OCaml.Parser.Int.Test - ( test - , testStrings - , unitTests + ( testStrings ) where -import Test.Tasty - -import Language.OCaml.Parser.Internal -import Language.OCaml.Parser.TestUtils - testStrings :: [String] testStrings = -- decimal literals @@ -27,10 +18,3 @@ , "0b01" , "0B01" ] - -unitTests :: TestTree -unitTests = testGroup "Language.OCaml.Parser.Int" $ [] - ++ map (mkParsingTest "valLongIdentP" valLongidentP) testStrings - -test :: IO () -test = defaultMain unitTests diff --git a/test/Language/OCaml/Parser/LetBinding/Test.hs b/test/Language/OCaml/Parser/LetBinding/Test.hs --- a/test/Language/OCaml/Parser/LetBinding/Test.hs +++ b/test/Language/OCaml/Parser/LetBinding/Test.hs @@ -17,9 +17,9 @@ testStrings :: [String] -> [String] testStrings structure = [] - ++ [ [i| let #{ea} #{rf} #{lbb} #{pia} |] - | ea <- extAttributes - , rf <- recFlag + ++ [ [i|let #{ea} #{rf} #{lbb} #{pia}|] + | ea <- extAttributes + , rf <- recFlag , lbb <- letBindingBody , pia <- postItemAttributes ] diff --git a/test/Language/OCaml/Parser/LetBindingBody/Test.hs b/test/Language/OCaml/Parser/LetBindingBody/Test.hs --- a/test/Language/OCaml/Parser/LetBindingBody/Test.hs +++ b/test/Language/OCaml/Parser/LetBindingBody/Test.hs @@ -4,20 +4,32 @@ ( testStrings ) where -import Data.String.Interpolate +import Data.String.Interpolate -import qualified Language.OCaml.Parser.StrictBinding.Test as StrictBinding -import qualified Language.OCaml.Parser.ValIdent.Test as ValIdent +import qualified Language.OCaml.Parser.CoreType.Test as CoreType +import qualified Language.OCaml.Parser.SimplePatternNotIdent.Test as SimplePatternNotIdent +import qualified Language.OCaml.Parser.SeqExpr.Test as SeqExpr +import qualified Language.OCaml.Parser.StrictBinding.Test as StrictBinding +import qualified Language.OCaml.Parser.ValIdent.Test as ValIdent limit :: Int limit = 100 testStrings :: [String] testStrings = [] - ++ [ [i| #{vi} #{sb} |] + ++ [ [i|#{vi} #{sb}|] | vi <- valIdent , sb <- strictBinding ] + -- TODO + ++ [ [i|#{spni} : #{ct} = #{se}|] + | spni <- simplePatternNotIdent + , ct <- coreType + , se <- seqExpr + ] where - valIdent = take limit $ ValIdent.testStrings - strictBinding = take limit $ StrictBinding.testStrings + coreType = take limit $ CoreType.testStrings + seqExpr = take limit $ SeqExpr.testStrings + simplePatternNotIdent = take limit $ SimplePatternNotIdent.testStrings + strictBinding = take limit $ StrictBinding.testStrings + valIdent = take limit $ ValIdent.testStrings diff --git a/test/Language/OCaml/Parser/MatchCase/Test.hs b/test/Language/OCaml/Parser/MatchCase/Test.hs --- a/test/Language/OCaml/Parser/MatchCase/Test.hs +++ b/test/Language/OCaml/Parser/MatchCase/Test.hs @@ -1,25 +1,10 @@ -{-# LANGUAGE OverloadedStrings #-} - module Language.OCaml.Parser.MatchCase.Test - ( test - , unitTests + ( testStrings ) where -import Test.Tasty - -import Language.OCaml.Parser.Internal -import Language.OCaml.Parser.TestUtils - -matchCaseTests :: [String] -matchCaseTests = +testStrings :: [String] +testStrings = [ "a -> b" , "a -> B.c_d" , "a when b -> c" ] - -unitTests :: TestTree -unitTests = testGroup "Language.OCaml.Parser.MatchCase" $ [] - ++ map (mkParsingTest "matchCaseP" matchCaseP) matchCaseTests - -test :: IO () -test = defaultMain unitTests diff --git a/test/Language/OCaml/Parser/ModLongident/Test.hs b/test/Language/OCaml/Parser/ModLongident/Test.hs --- a/test/Language/OCaml/Parser/ModLongident/Test.hs +++ b/test/Language/OCaml/Parser/ModLongident/Test.hs @@ -1,25 +1,9 @@ -{-# LANGUAGE OverloadedStrings #-} - module Language.OCaml.Parser.ModLongident.Test - ( test - , testStrings - , unitTests + ( testStrings ) where -import Test.Tasty - -import Language.OCaml.Parser.Internal -import Language.OCaml.Parser.TestUtils - testStrings :: [String] testStrings = [ "Mod" , "Mod.Mod" ] - -unitTests :: TestTree -unitTests = testGroup "Language.OCaml.Parser.ModLongident" $ [] - ++ map (mkParsingTest "modLongidentP" modLongidentP) testStrings - -test :: IO () -test = defaultMain unitTests diff --git a/test/Language/OCaml/Parser/OpenStatement/Test.hs b/test/Language/OCaml/Parser/OpenStatement/Test.hs --- a/test/Language/OCaml/Parser/OpenStatement/Test.hs +++ b/test/Language/OCaml/Parser/OpenStatement/Test.hs @@ -1,27 +1,12 @@ -{-# LANGUAGE OverloadedStrings #-} - module Language.OCaml.Parser.OpenStatement.Test - ( test - , unitTests + ( testStrings ) where -import Test.Tasty - -import Language.OCaml.Parser.Internal -import Language.OCaml.Parser.TestUtils - -openStatementTests :: [String] -openStatementTests = +testStrings :: [String] +testStrings = [ "open A" , "open !A" -- , "(* A *) open !A" , "open !A (* A *)" -- , "(* A *) open !A (* A *)" ] - -unitTests :: TestTree -unitTests = testGroup "Language.OCaml.Parser.OpenStatement" $ [] - ++ map (mkParsingTest "openStatementP" (openStatementP structureP)) openStatementTests - -test :: IO () -test = defaultMain unitTests diff --git a/test/Language/OCaml/Parser/Pattern/Test.hs b/test/Language/OCaml/Parser/Pattern/Test.hs --- a/test/Language/OCaml/Parser/Pattern/Test.hs +++ b/test/Language/OCaml/Parser/Pattern/Test.hs @@ -1,17 +1,9 @@ -{-# LANGUAGE OverloadedStrings #-} - module Language.OCaml.Parser.Pattern.Test - ( test - , unitTests + ( testStrings ) where -import Test.Tasty - -import Language.OCaml.Parser.Internal -import Language.OCaml.Parser.TestUtils - -patternTests :: [String] -patternTests = +testStrings :: [String] +testStrings = [ "_" , "a" , "A" @@ -22,10 +14,3 @@ , "_, _" , "A _, B _" ] - -unitTests :: TestTree -unitTests = testGroup "Language.OCaml.Parser.Pattern" $ [] - ++ map (mkParsingTest "patternP" patternP) patternTests - -test :: IO () -test = defaultMain unitTests diff --git a/test/Language/OCaml/Parser/SimpleCoreType/Test.hs b/test/Language/OCaml/Parser/SimpleCoreType/Test.hs new file mode 100644 --- /dev/null +++ b/test/Language/OCaml/Parser/SimpleCoreType/Test.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE QuasiQuotes #-} + +module Language.OCaml.Parser.SimpleCoreType.Test + ( testStrings + ) where + +-- import Data.String.Interpolate + +import qualified Language.OCaml.Parser.SimpleCoreType2.Test as SimpleCoreType2 + +testStrings :: [String] +testStrings = [] + ++ simpleCoreType2 + -- TODO + where + simpleCoreType2 = SimpleCoreType2.testStrings diff --git a/test/Language/OCaml/Parser/SimpleCoreType2/Test.hs b/test/Language/OCaml/Parser/SimpleCoreType2/Test.hs new file mode 100644 --- /dev/null +++ b/test/Language/OCaml/Parser/SimpleCoreType2/Test.hs @@ -0,0 +1,20 @@ +{-# LANGUAGE QuasiQuotes #-} + +module Language.OCaml.Parser.SimpleCoreType2.Test + ( testStrings + ) where + +import Data.String.Interpolate +import Prelude hiding (id) + +import qualified Language.OCaml.Parser.Ident.Test as Ident + +testStrings :: [String] +testStrings = [] + ++ [ [i| #{id} |] + | id <- ident + ] + ++ ["_"] + -- TODO + where + ident = Ident.testStrings diff --git a/test/Language/OCaml/Parser/SimpleCoreTypeOrTuple/Test.hs b/test/Language/OCaml/Parser/SimpleCoreTypeOrTuple/Test.hs new file mode 100644 --- /dev/null +++ b/test/Language/OCaml/Parser/SimpleCoreTypeOrTuple/Test.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE QuasiQuotes #-} + +module Language.OCaml.Parser.SimpleCoreTypeOrTuple.Test + ( testStrings + ) where + +-- import Data.String.Interpolate + +import qualified Language.OCaml.Parser.SimpleCoreType.Test as SimpleCoreType + +testStrings :: [String] +testStrings = [] + ++ simpleCoreType + -- TODO + where + simpleCoreType = SimpleCoreType.testStrings diff --git a/test/Language/OCaml/Parser/SimplePattern/Test.hs b/test/Language/OCaml/Parser/SimplePattern/Test.hs --- a/test/Language/OCaml/Parser/SimplePattern/Test.hs +++ b/test/Language/OCaml/Parser/SimplePattern/Test.hs @@ -1,26 +1,11 @@ -{-# LANGUAGE OverloadedStrings #-} - module Language.OCaml.Parser.SimplePattern.Test - ( test - , unitTests + ( testStrings ) where -import Test.Tasty - -import Language.OCaml.Parser.Internal -import Language.OCaml.Parser.TestUtils - -simplePatternTests :: [String] -simplePatternTests = +testStrings :: [String] +testStrings = [ "_" , "a" , "A" , "A.B" ] - -unitTests :: TestTree -unitTests = testGroup "Language.OCaml.Parser.Pattern" $ [] - ++ map (mkParsingTest "simplePatternP" simplePatternP) simplePatternTests - -test :: IO () -test = defaultMain unitTests diff --git a/test/Language/OCaml/Parser/SimplePatternNotIdent/Test.hs b/test/Language/OCaml/Parser/SimplePatternNotIdent/Test.hs new file mode 100644 --- /dev/null +++ b/test/Language/OCaml/Parser/SimplePatternNotIdent/Test.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE QuasiQuotes #-} + +module Language.OCaml.Parser.SimplePatternNotIdent.Test + ( testStrings + ) where + +-- import Data.String.Interpolate + +-- import qualified Language.OCaml.Parser.CoreTypeNoAttr.Test as CoreTypeNoAttr + +testStrings :: [String] +testStrings = [] + ++ ["_"] + -- TODO + where + -- coreTypeNoAttr = CoreTypeNoAttr.testStrings diff --git a/test/Language/OCaml/Parser/Structure/Test.hs b/test/Language/OCaml/Parser/Structure/Test.hs --- a/test/Language/OCaml/Parser/Structure/Test.hs +++ b/test/Language/OCaml/Parser/Structure/Test.hs @@ -1,30 +1,25 @@ {-# LANGUAGE QuasiQuotes #-} module Language.OCaml.Parser.Structure.Test - ( test - , testStrings - , unitTests + ( testStrings ) where import Data.String.Interpolate -import Test.Tasty -import Language.OCaml.Parser.Internal import qualified Language.OCaml.Parser.Payload.Test as Payload import qualified Language.OCaml.Parser.PostItemAttributes.Test as PostItemAttributes import qualified Language.OCaml.Parser.SeqExpr.Test as SeqExpr import qualified Language.OCaml.Parser.StructureTail.Test as StructureTail -import Language.OCaml.Parser.TestUtils limit :: Int -limit = 2 +limit = 4 testStrings :: [String] testStrings = [] ++ [ [i|#{se} #{pia} #{st}|] - | se <- seqExpr + | se <- seqExpr , pia <- postItemAttributes - , st <- structureTail + , st <- structureTail ] where payload = take limit $ Payload.testStrings structure @@ -32,12 +27,3 @@ seqExpr = take limit $ SeqExpr.testStrings structure = take limit $ testStrings structureTail = take limit $ StructureTail.testStrings structure - -unitTests :: TestTree -unitTests = testGroup "Language.OCaml.Parser.Structure" $ [] - ++ map (mkParsingTest "structureP" structureP) testStrings - -test :: IO () -test = defaultMain unitTests - --- debug = debugParsing structureP (structureTests !! 9) diff --git a/test/Language/OCaml/Parser/StructureItem/Test.hs b/test/Language/OCaml/Parser/StructureItem/Test.hs --- a/test/Language/OCaml/Parser/StructureItem/Test.hs +++ b/test/Language/OCaml/Parser/StructureItem/Test.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE QuasiQuotes #-} - module Language.OCaml.Parser.StructureItem.Test ( testStrings ) where diff --git a/test/Language/OCaml/Parser/TestStrings.hs b/test/Language/OCaml/Parser/TestStrings.hs --- a/test/Language/OCaml/Parser/TestStrings.hs +++ b/test/Language/OCaml/Parser/TestStrings.hs @@ -1,6 +1,8 @@ module Language.OCaml.Parser.TestStrings ( attributes , expr + , implementation + , letBinding , payload , seqExpr , simpleExpr @@ -11,6 +13,8 @@ import qualified Language.OCaml.Parser.Attributes.Test as Attributes import qualified Language.OCaml.Parser.Expr.Test as Expr +import qualified Language.OCaml.Parser.Implementation.Test as Implementation +import qualified Language.OCaml.Parser.LetBinding.Test as LetBinding import qualified Language.OCaml.Parser.Payload.Test as Payload import qualified Language.OCaml.Parser.SeqExpr.Test as SeqExpr import qualified Language.OCaml.Parser.SimpleExpr.Test as SimpleExpr @@ -23,6 +27,12 @@ expr :: [String] expr = Expr.testStrings seqExpr + +implementation :: [String] +implementation = Implementation.testStrings + +letBinding :: [String] +letBinding = LetBinding.testStrings structure payload :: [String] payload = Payload.testStrings structure diff --git a/test/Language/OCaml/Parser/TestUtils.hs b/test/Language/OCaml/Parser/TestUtils.hs --- a/test/Language/OCaml/Parser/TestUtils.hs +++ b/test/Language/OCaml/Parser/TestUtils.hs @@ -1,64 +1,27 @@ module Language.OCaml.Parser.TestUtils - ( compareParses - , debugParsing - , mkParsingTest - , mkParsingTestG + ( mkParsingTest , mkParsingTestFromFile - , mkParsingTestFromFileG , parse ) where -import Data.Void import Text.Megaparsec import Test.Tasty import Test.Tasty.HUnit import Language.OCaml.Parser -import Language.OCaml.Parser.Internal -import Language.OCaml.Parser.Utils.Utils -assertParsesC :: ParserC a -> String -> Assertion -assertParsesC parser input = do - case parseMaybe parser input of - Nothing -> assertFailure $ "Failed to parse: " ++ take 60 input - Just _ -> return () - -assertParsesG :: ParserG a -> String -> Assertion -assertParsesG parser input = do +assertParses :: Parser a -> String -> Assertion +assertParses parser input = do case parser input of Left msg -> assertFailure msg Right _ -> return () -mkParsingTest :: TestName -> Parser a -> String -> TestTree -mkParsingTest name parser input = testCase name $ assertParsesC parser input - -mkParsingTestG :: (String -> Either String a) -> String -> TestTree -mkParsingTestG parser input = testCase shortInput $ assertParsesG parser input +mkParsingTest :: (String -> Either String a) -> String -> TestTree +mkParsingTest parser input = testCase shortInput $ assertParses parser input where shortInput | length input <= 40 = input | otherwise = take 40 input ++ "..." -mkParsingTestFromFile :: Parser a -> FilePath -> TestTree -mkParsingTestFromFile parser fileName = testCase fileName $ readFile fileName >>= assertParsesC parser - -mkParsingTestFromFileG :: (String -> Either String a) -> FilePath -> TestTree -mkParsingTestFromFileG parser fileName = testCase fileName $ readFile fileName >>= assertParsesG parser - -debugParsing :: Parser a -> String -> Either (ParseError (Token String) Void) a -debugParsing parser input = - parse (ocamlSpace *> parser <* eof) "DEBUG" input - -compareParses :: - (Eq a, Show a) => - TestName -> Parser a -> (String -> Either String a) -> String -> TestTree -compareParses name parserC parserG input = - testCase name $ do - case (parseMaybe parserC input, parserG input) of - (Just outputC, Right outputG) -> (outputC == outputG) - @? ("Results differ:\n" - ++ "Combinator: " ++ show outputC ++ "\n" - ++ "Generator: " ++ show outputG ++ "\n" - ) - (Just _, Left _) -> False @? "Parser generator failed" - (Nothing, Right _) -> False @? "Parser combinator failed" - (Nothing, Left _) -> False @? "Both parsers failed" +mkParsingTestFromFile :: (String -> Either String a) -> FilePath -> TestTree +mkParsingTestFromFile parser fileName = + testCase fileName $ readFile fileName >>= assertParses parser diff --git a/test/Language/OCaml/Parser/Tokens/Test.hs b/test/Language/OCaml/Parser/Tokens/Test.hs deleted file mode 100644 --- a/test/Language/OCaml/Parser/Tokens/Test.hs +++ /dev/null @@ -1,37 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE QuasiQuotes #-} - -module Language.OCaml.Parser.Tokens.Test - ( test - , unitTests - ) where - -import Data.String.QQ --- import Text.Megaparsec -import Test.Tasty - -import Language.OCaml.Parser.Internal -import Language.OCaml.Parser.TestUtils - --- lIdentTests :: [String] --- lIdentTests = [ "a", "a " ] - --- uIdentTests :: [String] --- uIdentTests = [ "A", "A " ] - --- starTests :: [String] --- starTests = [ "*", "* ", " *", " * " ] - -stringTests :: [String] -stringTests = - [ [s|"foo"|] - ] - -unitTests :: TestTree -unitTests = testGroup "Language.OCaml.Parser.Tokens" $ [] - ++ map (mkParsingTest "stringT" stringT) stringTests - -test :: IO () -test = defaultMain unitTests - --- foo = debugParsing (stringT *> stringT) [s|"foo" "bar"|] diff --git a/test/Language/OCaml/PrettyPrinter/TestUtils.hs b/test/Language/OCaml/PrettyPrinter/TestUtils.hs --- a/test/Language/OCaml/PrettyPrinter/TestUtils.hs +++ b/test/Language/OCaml/PrettyPrinter/TestUtils.hs @@ -17,7 +17,7 @@ import Language.OCaml.Parser -mkPrettyPrinterTest :: (Eq a) => TestName -> ParserG a -> (a -> Doc b) -> String -> TestTree +mkPrettyPrinterTest :: (Eq a) => TestName -> Parser a -> (a -> Doc b) -> String -> TestTree mkPrettyPrinterTest name parser printer input = testCase name $ condition @? message where @@ -55,7 +55,7 @@ ++ show (pretty a) ++ "\n" debugPrettyPrinter :: - (Eq a) => ParserG a -> (a -> Doc b) -> String -> DebugPrettyPrinter a b + (Eq a) => Parser a -> (a -> Doc b) -> String -> DebugPrettyPrinter a b debugPrettyPrinter parser printer input = case parser input of Left _ -> NoParse1 @@ -64,8 +64,8 @@ Left _ -> NoParse2 r (printer r) Right r' -> if r == r' then ParseEq r' else ParseDiff r r' -parseAndPrettyPrint :: ParserG a -> (a -> Doc b) -> String -> Either String (Doc b) +parseAndPrettyPrint :: Parser a -> (a -> Doc b) -> String -> Either String (Doc b) parseAndPrettyPrint parser printer input = printer <$> parser input -roundtrip :: ParserG a -> (a -> Doc b) -> String -> Either String String +roundtrip :: Parser a -> (a -> Doc b) -> String -> Either String String roundtrip p pp s = (show . pp) <$> p s diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -2,15 +2,13 @@ module Main where -import Test.Tasty +import Test.Tasty --- import qualified Language.OCaml.Parser.Common.Test --- import qualified Language.OCaml.Parser.ConstrLongident.Test --- import qualified Language.OCaml.Parser.Expr.Test -- import qualified Language.OCaml.Parser.Generator.Common.Test -- import qualified Language.OCaml.Parser.Generator.ConstrLongident.Test import qualified Language.OCaml.Parser.Generator.Expr.Test import qualified Language.OCaml.Parser.Generator.Implementation.Test +import qualified Language.OCaml.Parser.Generator.LetBinding.Test -- import qualified Language.OCaml.Parser.Generator.MatchCase.Test -- import qualified Language.OCaml.Parser.Generator.ModLongident.Test -- import qualified Language.OCaml.Parser.Generator.OpenStatement.Test @@ -18,12 +16,12 @@ import qualified Language.OCaml.Parser.Generator.SeqExpr.Test import qualified Language.OCaml.Parser.Generator.SimpleExpr.Test -- import qualified Language.OCaml.Parser.Generator.SimplePattern.Test --- import qualified Language.OCaml.Parser.Generator.Structure.Test +import qualified Language.OCaml.Parser.Generator.Structure.Test -- import qualified Language.OCaml.Parser.Generator.StructureItem.Test -- import qualified Language.OCaml.Parser.Generator.Tokens.Test -- import qualified Language.OCaml.Parser.Generator.ValIdent.Test import qualified Language.OCaml.Parser.Generator.ValLongident.Test --- import qualified Language.OCaml.Parser.Implementation.Test +import Language.OCaml.Parser.Implementation.Test -- import qualified Language.OCaml.Parser.MatchCase.Test -- import qualified Language.OCaml.Parser.ModLongident.Test -- import qualified Language.OCaml.Parser.OpenStatement.Test @@ -40,34 +38,17 @@ import qualified Language.OCaml.PrettyPrinter.Structure.Test main :: IO () -main = defaultMain tests +main = do + mlFiles <- listMLFiles + defaultMain $ tests mlFiles -tests :: TestTree -tests = testGroup "Tests" $ [] - -- ++ [ testGroup "Parser combinator" $ - -- [ Language.OCaml.Parser.Common.Test.unitTests - -- , Language.OCaml.Parser.ConstrLongident.Test.unitTests - -- , Language.OCaml.Parser.Expr.Test.unitTests - -- , Language.OCaml.Parser.Implementation.Test.unitTests - -- , Language.OCaml.Parser.MatchCase.Test.unitTests - -- , Language.OCaml.Parser.ModLongident.Test.unitTests - -- , Language.OCaml.Parser.OpenStatement.Test.unitTests - -- , Language.OCaml.Parser.Pattern.Test.unitTests - -- , Language.OCaml.Parser.SeqExpr.Test.unitTests - -- , Language.OCaml.Parser.SimpleExpr.Test.unitTests - -- , Language.OCaml.Parser.SimplePattern.Test.unitTests - -- , Language.OCaml.Parser.Structure.Test.unitTests - -- , Language.OCaml.Parser.StructureItem.Test.unitTests - -- , Language.OCaml.Parser.Tokens.Test.unitTests - -- , Language.OCaml.Parser.ValIdent.Test.unitTests - -- , Language.OCaml.Parser.ValLongident.Test.unitTests - -- ] - -- ] +tests :: [FilePath] -> TestTree +tests mlFiles = testGroup "Tests" $ [] ++ [ testGroup "Parser generator" $ -- [ Language.OCaml.Parser.Generator.Common.Test.unitTests -- , Language.OCaml.Parser.Generator.ConstrLongident.Test.unitTests [ Language.OCaml.Parser.Generator.Expr.Test.unitTests - , Language.OCaml.Parser.Generator.Implementation.Test.unitTests + , Language.OCaml.Parser.Generator.LetBinding.Test.unitTests -- , Language.OCaml.Parser.Generator.MatchCase.Test.unitTests -- , Language.OCaml.Parser.Generator.ModLongident.Test.unitTests -- , Language.OCaml.Parser.Generator.OpenStatement.Test.unitTests @@ -75,12 +56,13 @@ , Language.OCaml.Parser.Generator.SeqExpr.Test.unitTests , Language.OCaml.Parser.Generator.SimpleExpr.Test.unitTests -- , Language.OCaml.Parser.Generator.SimplePattern.Test.unitTests - -- , Language.OCaml.Parser.Generator.Structure.Test.unitTests + , Language.OCaml.Parser.Generator.Structure.Test.unitTests -- , Language.OCaml.Parser.Generator.StructureItem.Test.unitTests -- , Language.OCaml.Parser.Generator.Tokens.Test.unitTests -- , Language.OCaml.Parser.Generator.ValIdent.Test.unitTests , Language.OCaml.Parser.Generator.ValLongident.Test.unitTests ] + ++ [ Language.OCaml.Parser.Generator.Implementation.Test.mkUnitTest mlFiles ] ] ++ [ testGroup "PrettyPrinter" $ [ Language.OCaml.PrettyPrinter.Structure.Test.unitTests