language-oberon 0.1.1 → 0.2

raw patch · 6 files changed

+61/−63 lines, 6 filesdep ~grammatical-parsersdep ~rank2classesPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: grammatical-parsers, rank2classes

API changes (from Hackage documentation)

Files

• app/Parse.hs +13/−10
• language-oberon.cabal +3/−3
• src/Language/Oberon.hs +3/−3
• src/Language/Oberon/AST.hs +19/−31
• src/Language/Oberon/Grammar.hs +18/−14
• src/Language/Oberon/Resolver.hs +5/−2

@@ -15,7 +15,7 @@ import Data.Either.Validation (Validation(..), validationToEither) import Data.Functor.Identity (Identity) import Data.Functor.Compose (getCompose)-import Data.List.NonEmpty (NonEmpty)+import Data.List.NonEmpty (NonEmpty((:|))) import qualified Data.Map.Lazy as Map import Data.Maybe (fromMaybe) import Data.Monoid ((<>))@@ -23,7 +23,7 @@ import Data.Text.IO (getLine, readFile, getContents) import Data.Typeable (Typeable) import Options.Applicative-import Text.Grampa (Ambiguous, Grammar, ParseResults, parseComplete)+import Text.Grampa (Ambiguous, Grammar, ParseResults, parseComplete, showFailure) import qualified Text.Grampa.ContextFree.LeftRecursive as LeftRecursive import ReprTree import System.FilePath (FilePath, takeDirectory)@@ -84,7 +84,7 @@                          of ModuleWithImportsMode ->                                \source-> parseAndResolveModule optsOberon2                                                                (fromMaybe (takeDirectory file) optsInclude) source-                                         >>= succeed optsOutput+                                         >>= succeed optsOutput source                             ModuleMode          -> go (Resolver.resolveModule predefined mempty) Grammar.module_prod                                                    chosenGrammar file                             DefinitionMode      -> go (Resolver.resolveModule predefined mempty) Grammar.module_prod@@ -114,15 +114,18 @@        -> String -> Text -> IO ()     go resolve production grammar filename contents =        case getCompose (production $ parseComplete grammar contents)-       of Right [x] -> succeed optsOutput (resolve x)+       of Right [x] -> succeed optsOutput contents (resolve x)           Right l -> putStrLn ("Ambiguous: " ++ show optsIndex ++ "/" ++ show (length l) ++ " parses")-                     >> succeed optsOutput (resolve $ l !! optsIndex)-          Left err -> error (show err)+                     >> succeed optsOutput contents (resolve $ l !! optsIndex)+          Left err -> putStrLn (showFailure contents err 3) -succeed out x = case out-                of Pretty width -> either print (putDocW width . pretty) (validationToEither x)-                   Tree -> either print (putStrLn . reprTreeString) (validationToEither x)-                   Plain -> print x+succeed out contents x = either reportFailure showSuccess (validationToEither x)+   where reportFailure (Resolver.UnparseableModule err :| []) = putStrLn (showFailure contents err 3)+         reportFailure errs = print errs+         showSuccess = case out+                       of Pretty width -> putDocW width . pretty+                          Tree -> putStrLn . reprTreeString+                          Plain -> print  instance Pretty (Module Ambiguous) where    pretty _ = error "Disambiguate before pretty-printing"

@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                language-oberon-version:             0.1.1+version:             0.2 synopsis:            Parser and pretty-printer for the Oberon programming language description:    The library and the executable support both the original Oberon and the Oberon-2 programming language, as described@@ -36,7 +36,7 @@                         Language.Oberon.Pretty, Language.Oberon.Resolver   build-depends:        base >= 4.7 && < 5, text < 1.3, containers >= 0.5 && < 1.0, filepath < 1.5, directory < 1.4,                         parsers >= 0.12.7 && < 0.13, prettyprinter >= 1 && < 1.3, either == 5.*,-                        rank2classes < 1.1, grammatical-parsers == 0.3.*+                        rank2classes < 1.2, grammatical-parsers >= 0.3.1 && < 0.4   default-language:     Haskell2010  executable parse@@ -45,7 +45,7 @@   other-extensions:    RankNTypes, RecordWildCards, ScopedTypeVariables, FlexibleInstances, DeriveDataTypeable   build-depends:       base >= 4.7 && < 5, text < 1.3, either == 5.*, containers >= 0.5 && < 1.0,                        repr-tree-syb < 0.2, filepath < 1.5, prettyprinter >= 1 && < 1.3,-                       rank2classes < 1.1, grammatical-parsers == 0.3.*, language-oberon,+                       rank2classes < 1.2, grammatical-parsers >= 0.3.1 && < 0.4, language-oberon,                        optparse-applicative   default-language:    Haskell2010 

@@ -9,7 +9,7 @@ import Data.Either.Validation (Validation(..)) import Data.Functor.Identity (Identity) import Data.Functor.Compose (getCompose)-import Data.List.NonEmpty (NonEmpty)+import Data.List.NonEmpty (NonEmpty((:|))) import qualified Data.Map.Lazy as Map import Data.Map.Lazy (Map) import Data.Monoid ((<>))@@ -61,13 +61,13 @@ parseAndResolveModule :: Bool -> FilePath -> Text -> IO (Validation (NonEmpty Resolver.Error) (Module Identity)) parseAndResolveModule oberon2 path source =    case parseModule oberon2 source-   of Left err -> error (show err)+   of Left err -> return (Failure $ Resolver.UnparseableModule err :| [])       Right [rootModule@(Module moduleName imports _ _ _)] ->          do importedModules <- parseImportsOf oberon2 path (Map.singleton moduleName rootModule)             let resolvedImportMap = Resolver.resolveModule predefinedScope resolvedImportMap <$> importedModules                 predefinedScope = if oberon2 then Resolver.predefined2 else Resolver.predefined             return $ Resolver.resolveModule predefinedScope resolvedImportMap rootModule-      Right _ -> error "Ambiguous parsings"+      Right _ -> return (Failure $ Resolver.AmbiguousParses :| [])  -- | Parse the module file at the given path, assuming all its imports are in the same directory. parseAndResolveModuleFile :: Bool -> FilePath -> IO (Validation (NonEmpty Resolver.Error) (Module Identity))

@@ -4,7 +4,7 @@  module Language.Oberon.AST where -import Data.Data (Data)+import Data.Data (Data, Typeable) import Data.Functor.Identity (Identity) import Data.List.NonEmpty import Data.Text@@ -12,8 +12,8 @@  data Module f = Module Ident [Import] [Declaration f] (Maybe (StatementSequence f)) Ident -deriving instance Data (Module Identity)-deriving instance Data (Module Ambiguous)+deriving instance (Typeable f, Data (f (Designator f)), Data (f (Expression f)), Data (f (Statement f))) =>+                  Data (Module f) deriving instance (Show (f (Designator f)), Show (f (Expression f)), Show (f (Statement f))) => Show (Module f)  type Ident = Text@@ -26,8 +26,8 @@                     | ProcedureDeclaration (ProcedureHeading f) (ProcedureBody f) Ident                     | ForwardDeclaration IdentDef (Maybe (FormalParameters f)) -deriving instance Data (Declaration Identity)-deriving instance Data (Declaration Ambiguous)+deriving instance (Typeable f, Data (f (Designator f)), Data (f (Expression f)), Data (f (Statement f))) =>+                  Data (Declaration f) deriving instance (Show (f (Designator f)), Show (f (Expression f)), Show (f (Statement f))) => Show (Declaration f)  data IdentDef = IdentDef Ident AccessMode@@ -60,8 +60,7 @@                   | FunctionCall (AmbDesignator f) (ActualParameters f)                   | Not (Expression f) -deriving instance Data (Expression Identity)-deriving instance Data (Expression Ambiguous)+deriving instance (Typeable f, Data (f (Designator f))) => Data (Expression f) deriving instance Show (f (Designator f)) => Show (Expression f)  data RelOp = Equal | Unequal | Less | LessOrEqual | Greater | GreaterOrEqual | In | Is@@ -70,8 +69,7 @@ data Element f = Element (Expression f)                | Range (Expression f) (Expression f) -deriving instance Data (Element Identity)-deriving instance Data (Element Ambiguous)+deriving instance (Typeable f, Data (f (Designator f))) => Data (Element f) deriving instance Show (f (Designator f)) => Show (Element f)  type AmbDesignator f = f (Designator f)@@ -82,8 +80,7 @@                   | TypeGuard (Designator f) QualIdent                    | Dereference (Designator f) -deriving instance Data (Designator Identity)-deriving instance Data (Designator Ambiguous)+deriving instance (Typeable f, Data (f (Designator f))) => Data (Designator f) deriving instance Show (f (Designator f)) => Show (Designator f)  type ActualParameters f = [Expression f]@@ -94,8 +91,7 @@             | PointerType (Type f)             | ProcedureType (Maybe (FormalParameters f)) -deriving instance Data (Type Identity)-deriving instance Data (Type Ambiguous)+deriving instance (Typeable f, Data (f (Designator f)), Data (f (Expression f))) => Data (Type f) deriving instance (Show (f (Designator f)), Show (f (Expression f))) => Show (Type f)  data QualIdent = QualIdent Ident Ident @@ -109,8 +105,7 @@ data FieldList f = FieldList IdentList (Type f)                  | EmptyFieldList -deriving instance Data (FieldList Identity)-deriving instance Data (FieldList Ambiguous)+deriving instance (Typeable f, Data (f (Designator f)), Data (f (Expression f))) => Data (FieldList f) deriving instance (Show (f (Designator f)), Show (f (Expression f))) => Show (FieldList f)  type IdentList = NonEmpty IdentDef@@ -119,22 +114,19 @@ data FormalParameters f  = FormalParameters [FPSection f] (Maybe QualIdent) data FPSection f  =  FPSection Bool (NonEmpty Ident) (Type f) -deriving instance Data (ProcedureHeading Identity)-deriving instance Data (ProcedureHeading Ambiguous)+deriving instance (Typeable f, Data (f (Designator f)),  Data (f (Expression f))) => Data (ProcedureHeading f) deriving instance (Show (f (Designator f)),  Show (f (Expression f))) => Show (ProcedureHeading f) -deriving instance Data (FormalParameters Identity)-deriving instance Data (FormalParameters Ambiguous)+deriving instance (Typeable f, Data (f (Designator f)),  Data (f (Expression f))) => Data (FormalParameters f) deriving instance (Show (f (Designator f)),  Show (f (Expression f))) => Show (FormalParameters f) -deriving instance Data (FPSection Identity)-deriving instance Data (FPSection Ambiguous)+deriving instance (Typeable f, Data (f (Designator f)),  Data (f (Expression f))) => Data (FPSection f) deriving instance (Show (f (Designator f)),  Show (f (Expression f))) => Show (FPSection f)  data ProcedureBody f =  ProcedureBody [Declaration f] (Maybe (StatementSequence f)) -deriving instance Data (ProcedureBody Identity)-deriving instance Data (ProcedureBody Ambiguous)+deriving instance (Typeable f, Data (f (Designator f)), Data (f (Expression f)), Data (f (Statement f))) =>+                  Data (ProcedureBody f) deriving instance (Show (f (Designator f)), Show (f (Expression f)), Show (f (Statement f))) => Show (ProcedureBody f)  type StatementSequence f  = NonEmpty (f (Statement f))@@ -152,8 +144,7 @@                  | Exit                   | Return (Maybe (Expression f)) -deriving instance Data (Statement Identity)-deriving instance Data (Statement Ambiguous)+deriving instance (Typeable f, Data (f (Designator f)), Data (f (Statement f))) => Data (Statement f) deriving instance (Show (f (Designator f)), Show (f (Statement f))) => Show (Statement f)  data WithAlternative f = WithAlternative QualIdent QualIdent (StatementSequence f)@@ -164,14 +155,11 @@ data CaseLabels f = SingleLabel (ConstExpression f)                   | LabelRange (ConstExpression f) (ConstExpression f) -deriving instance Data (WithAlternative Identity)-deriving instance Data (WithAlternative Ambiguous)+deriving instance (Typeable f, Data (f (Designator f)), Data (f (Statement f))) => Data (WithAlternative f) deriving instance (Show (f (Designator f)), Show (f (Statement f))) => Show (WithAlternative f) -deriving instance Data (Case Identity)-deriving instance Data (Case Ambiguous)+deriving instance (Typeable f, Data (f (Designator f)), Data (f (Statement f))) => Data (Case f) deriving instance (Show (f (Designator f)), Show (f (Statement f))) => Show (Case f) -deriving instance Data (CaseLabels Identity)-deriving instance Data (CaseLabels Ambiguous)+deriving instance (Typeable f, Data (f (Designator f))) => Data (CaseLabels f) deriving instance Show (f (Designator f)) => Show (CaseLabels f)

@@ -15,7 +15,7 @@ import Data.Text (Text, unpack) import Text.Grampa import Text.Grampa.ContextFree.LeftRecursive (Parser)-import Text.Parser.Combinators (sepBy, sepBy1, sepByNonEmpty)+import Text.Parser.Combinators (sepBy, sepBy1, sepByNonEmpty, try) import Text.Parser.Token (braces, brackets, parens)  import qualified Rank2@@ -100,10 +100,10 @@  instance Lexical (OberonGrammar f) where    type LexicalConstraint p (OberonGrammar f) s = (s ~ Text, p ~ Parser)-   lexicalComment = string "(*"-                    *> skipMany (lexicalComment-                                 <|> notFollowedBy (string "*)") <* anyToken <* takeCharsWhile isCommentChar)-                    <* string "*)"+   lexicalComment = try (string "(*"+                         *> skipMany (lexicalComment+                                      <|> notFollowedBy (string "*)") <* anyToken <* takeCharsWhile isCommentChar)+                         <* string "*)")       where isCommentChar c = c /= '*' && c /= '('    lexicalWhiteSpace = takeCharsWhile isSpace *> skipMany (lexicalComment *> takeCharsWhile isSpace)    isIdentifierStartChar = isLetter@@ -139,6 +139,8 @@  grammar2 g@OberonGrammar{..} = g1{    identdef = IdentDef <$> ident <*> (Exported <$ delimiter "*" <|> ReadOnly <$ delimiter "-" <|> pure PrivateOnly),+   +   string_prod = string_prod1 <|> lexicalToken (char '\'' *> takeWhile (/= "'") <* char '\''),    procedureHeading = ProcedureHeading <$ keyword "PROCEDURE"                       <*> optional (parens                                     ((,,) <$> (True <$ keyword "VAR" <|> pure False)@@ -152,7 +154,7 @@                   <*> statementSequence <* keyword "END",    withStatement = With <$ keyword "WITH" <*> sepByNonEmpty withAlternative (delimiter "|")                         <*> optional (keyword "ELSE" *> statementSequence) <* keyword "END"}-   where g1@OberonGrammar{statement= statement1} = grammar g+   where g1@OberonGrammar{statement= statement1, string_prod= string_prod1} = grammar g          withAlternative = WithAlternative <$> qualident <* delimiter ":" <*> qualident                                            <*  keyword "DO" <*> statementSequence    @@ -169,11 +171,13 @@                                      <|> keyword "TYPE" *> many (typeDeclaration <* delimiter ";")                                      <|> keyword "VAR" *> many (variableDeclaration <* delimiter ";"))                          <> many (procedureDeclaration <* delimiter ";"-                                  <|> forwardDeclaration <* delimiter ";"),+                                  <|> forwardDeclaration <* delimiter ";")+                         <?> "declarations",    constantDeclaration = ConstantDeclaration <$> identdef <* delimiter "=" <*> ambiguous constExpression,    identdef = IdentDef <$> ident <*> (Exported <$ delimiter "*" <|> pure PrivateOnly),    constExpression = expression,-   expression = simpleExpression <**> (pure id <|> (flip . Relation) <$> relation <*> simpleExpression),+   expression = simpleExpression <**> (pure id <|> (flip . Relation) <$> relation <*> simpleExpression)+                <?> "expression",    simpleExpression = (Positive <$ operator "+" <|> Negative <$ operator "-" <|> pure id)                       <*> (term <**> (appEndo <$> concatMany (Endo <$> (flip . applyBinOp <$> addOperator <*> term)))),    term = factor <**> (appEndo <$> concatMany (Endo <$> (flip . applyBinOp <$> mulOperator <*> factor))),@@ -195,8 +199,7 @@    charConstant = lexicalToken (empty -- CharConstant <$ char '"' <*> anyChar <* char '"'                                 <|> CharCode . fst . head . readHex . unpack                                 <$> (digit <> takeCharsWhile isHexDigit <* string "X")),-   string_prod = lexicalToken (char '"' *> takeWhile (/= "\"") <* char '"'-                               <|> char '\'' *> takeWhile (/= "'") <* char '\''),   -- Oberon2+   string_prod = lexicalToken (char '"' *> takeWhile (/= "\"") <* char '"'),    set = Set <$> braces (sepBy element (delimiter ",")),    element = Element <$> expression               <|> Range <$> expression <* delimiter ".." <*> expression,@@ -228,7 +231,7 @@                 <*> fieldListSequence <* keyword "END",    baseType = qualident,    fieldListSequence = sepByNonEmpty fieldList (delimiter ";"),-   fieldList = FieldList <$> identList <* delimiter ":" <*> type_prod+   fieldList = (FieldList <$> identList <* delimiter ":" <*> type_prod <?> "record field declarations")                <|> pure EmptyFieldList,    identList = sepByNonEmpty identdef (delimiter ","),    pointerType = PointerType <$ keyword "POINTER" <* keyword "TO" <*> type_prod,@@ -253,7 +256,8 @@                <|> whileStatement <|> repeatStatement <|> loopStatement <|> withStatement                 <|> Exit <$ keyword "EXIT"                 <|> Return <$ keyword "RETURN" <*> optional expression-               <|> pure EmptyStatement,+               <|> pure EmptyStatement+               <?> "statement",    assignment  =  Assignment <$> ambiguous designator <* delimiter ":=" <*> expression,    procedureCall = ProcedureCall <$> ambiguous designator <*> optional actualParameters,    ifStatement = If <$ keyword "IF"@@ -281,8 +285,8 @@  delimiter, operator :: Text -> Parser (OberonGrammar f) Text Text -delimiter s = lexicalToken (string s)-operator = delimiter+delimiter s = lexicalToken (string s) <?> ("delimiter " <> show s)+operator s = lexicalToken (string s) <?> ("operator " <> show s)  reservedWords :: [Text] reservedWords = ["ARRAY", "IMPORT", "RETURN",

@@ -4,7 +4,8 @@ -- expression @foo(bar)@ may be a call to function @foo@ with a parameter @bar@, or it may be type guard on variable -- @foo@ casting it to type @bar@. -module Language.Oberon.Resolver (Error, Predefined, predefined, predefined2, resolveModule, resolveModules) where+module Language.Oberon.Resolver (Error(..),+                                 Predefined, predefined, predefined2, resolveModule, resolveModules) where  import Control.Applicative (Alternative) import Control.Monad ((>=>))@@ -19,7 +20,7 @@ import qualified Data.Map.Lazy as Map import Data.Semigroup (Semigroup(..), sconcat) -import Text.Grampa (Ambiguous(..))+import Text.Grampa (Ambiguous(..), ParseFailure)  import Language.Oberon.AST @@ -32,6 +33,7 @@ data Error = UnknownModule Ident            | UnknownLocal Ident            | UnknownImport QualIdent+           | AmbiguousParses            | AmbiguousDesignator [Designator Identity]            | AmbiguousExpression [Expression Identity]            | AmbiguousStatement [Statement Identity]@@ -45,6 +47,7 @@            | NotAValue QualIdent            | NotWriteable QualIdent            | ClashingImports+           | UnparseableModule ParseFailure            deriving (Show)  type Scope = Predefined