{-# Language FlexibleContexts, RecordWildCards, TypeFamilies #-}
module Language.Oberon (parseModule, parseAndResolveModule, parseAndResolveModuleFile,
LanguageVersion(..), Options(..), NodeWrap, Placed) where
import Language.Oberon.AST (Language, Module(..), Ident)
import qualified Language.Oberon.Grammar as Grammar
import qualified Language.Oberon.Resolver as Resolver
import qualified Language.Oberon.Reserializer as Reserializer
import qualified Language.Oberon.ConstantFolder as ConstantFolder
import qualified Language.Oberon.TypeChecker as TypeChecker
import Language.Oberon.Resolver (NodeWrap, Placed)
import qualified Transformation.Deep as Deep
import qualified Transformation.Full as Full
import Control.Monad (guard)
import Data.Either.Validation (Validation(..))
import Data.Functor.Compose (Compose(Compose, getCompose))
import Data.List.NonEmpty (NonEmpty((:|)))
import qualified Data.List.NonEmpty as NonEmpty
import qualified Data.Map.Lazy as Map
import Data.Map.Lazy (Map)
import Data.Monoid ((<>))
import Data.Text (Text, unpack)
import Data.Text.IO (readFile)
import Text.Grampa (Ambiguous(Ambiguous), Grammar, ParseResults, parseComplete, failureDescription)
import System.Directory (doesFileExist)
import System.FilePath (FilePath, addExtension, combine, takeDirectory)
import Prelude hiding (readFile)
data LanguageVersion = Oberon1 | Oberon2 deriving (LanguageVersion -> LanguageVersion -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LanguageVersion -> LanguageVersion -> Bool
$c/= :: LanguageVersion -> LanguageVersion -> Bool
== :: LanguageVersion -> LanguageVersion -> Bool
$c== :: LanguageVersion -> LanguageVersion -> Bool
Eq, Eq LanguageVersion
LanguageVersion -> LanguageVersion -> Bool
LanguageVersion -> LanguageVersion -> Ordering
LanguageVersion -> LanguageVersion -> LanguageVersion
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: LanguageVersion -> LanguageVersion -> LanguageVersion
$cmin :: LanguageVersion -> LanguageVersion -> LanguageVersion
max :: LanguageVersion -> LanguageVersion -> LanguageVersion
$cmax :: LanguageVersion -> LanguageVersion -> LanguageVersion
>= :: LanguageVersion -> LanguageVersion -> Bool
$c>= :: LanguageVersion -> LanguageVersion -> Bool
> :: LanguageVersion -> LanguageVersion -> Bool
$c> :: LanguageVersion -> LanguageVersion -> Bool
<= :: LanguageVersion -> LanguageVersion -> Bool
$c<= :: LanguageVersion -> LanguageVersion -> Bool
< :: LanguageVersion -> LanguageVersion -> Bool
$c< :: LanguageVersion -> LanguageVersion -> Bool
compare :: LanguageVersion -> LanguageVersion -> Ordering
$ccompare :: LanguageVersion -> LanguageVersion -> Ordering
Ord, Int -> LanguageVersion -> ShowS
[LanguageVersion] -> ShowS
LanguageVersion -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LanguageVersion] -> ShowS
$cshowList :: [LanguageVersion] -> ShowS
show :: LanguageVersion -> String
$cshow :: LanguageVersion -> String
showsPrec :: Int -> LanguageVersion -> ShowS
$cshowsPrec :: Int -> LanguageVersion -> ShowS
Show)
data Options = Options{
Options -> Bool
foldConstants :: Bool,
Options -> Bool
checkTypes :: Bool,
Options -> LanguageVersion
version :: LanguageVersion}
moduleGrammar :: LanguageVersion
-> Grammar (OberonGrammar Language NodeWrap) Parser Text
moduleGrammar LanguageVersion
Oberon1 = Grammar (OberonGrammar Language NodeWrap) Parser Text
Grammar.oberonGrammar
moduleGrammar LanguageVersion
Oberon2 = Grammar (OberonGrammar Language NodeWrap) Parser Text
Grammar.oberon2Grammar
definitionGrammar :: LanguageVersion
-> Grammar (OberonGrammar Language NodeWrap) Parser Text
definitionGrammar LanguageVersion
Oberon1 = Grammar (OberonGrammar Language NodeWrap) Parser Text
Grammar.oberonDefinitionGrammar
definitionGrammar LanguageVersion
Oberon2 = Grammar (OberonGrammar Language NodeWrap) Parser Text
Grammar.oberon2DefinitionGrammar
parseModule :: LanguageVersion -> Text -> ParseResults Text [NodeWrap (Module Language Language NodeWrap NodeWrap)]
parseModule :: LanguageVersion
-> Text
-> ParseResults
Text
[NodeWrap
(Module
Language
Language
(Compose ((,) (Int, Int)) (Compose Ambiguous ((,) ParsedLexemes)))
(Compose
((,) (Int, Int)) (Compose Ambiguous ((,) ParsedLexemes))))]
parseModule LanguageVersion
version Text
src =
forall {k1} {k2} (f :: k1 -> *) (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose (forall (p :: * -> *) (q :: * -> *)
(g :: (* -> *) -> (* -> *) -> *).
(p ~ NodeWrap,
q
~ Compose ((,) (Int, Int)) (Compose Ambiguous ((,) ParsedLexemes)),
Functor (Map p q) g) =>
Text -> p (g p p) -> q (g q q)
Resolver.resolvePositions Text
src forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall {k1} {k2} (f :: k1 -> *) (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose forall a b. (a -> b) -> a -> b
$ forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (f (Module l l f f))
Grammar.module_prod forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s (g :: (* -> *) -> *).
(MultiParsing m, ParserInput m ~ s, GrammarConstraint m g, Eq s,
FactorialMonoid s) =>
g m -> s -> g (ResultFunctor m)
parseComplete (LanguageVersion
-> Grammar (OberonGrammar Language NodeWrap) Parser Text
moduleGrammar LanguageVersion
version) Text
src))
parseDefinitionModule :: LanguageVersion -> Text
-> ParseResults Text [NodeWrap (Module Language Language NodeWrap NodeWrap)]
parseDefinitionModule :: LanguageVersion
-> Text
-> ParseResults
Text
[NodeWrap
(Module
Language
Language
(Compose ((,) (Int, Int)) (Compose Ambiguous ((,) ParsedLexemes)))
(Compose
((,) (Int, Int)) (Compose Ambiguous ((,) ParsedLexemes))))]
parseDefinitionModule LanguageVersion
version Text
src =
forall {k1} {k2} (f :: k1 -> *) (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose (forall (p :: * -> *) (q :: * -> *)
(g :: (* -> *) -> (* -> *) -> *).
(p ~ NodeWrap,
q
~ Compose ((,) (Int, Int)) (Compose Ambiguous ((,) ParsedLexemes)),
Functor (Map p q) g) =>
Text -> p (g p p) -> q (g q q)
Resolver.resolvePositions Text
src forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall {k1} {k2} (f :: k1 -> *) (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose forall a b. (a -> b) -> a -> b
$ forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (f (Module l l f f))
Grammar.module_prod forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s (g :: (* -> *) -> *).
(MultiParsing m, ParserInput m ~ s, GrammarConstraint m g, Eq s,
FactorialMonoid s) =>
g m -> s -> g (ResultFunctor m)
parseComplete (LanguageVersion
-> Grammar (OberonGrammar Language NodeWrap) Parser Text
definitionGrammar LanguageVersion
version) Text
src))
parseNamedModule :: LanguageVersion -> FilePath -> Text
-> IO (ParseResults Text [NodeWrap (Module Language Language NodeWrap NodeWrap)])
parseNamedModule :: LanguageVersion
-> String
-> Text
-> IO
(ParseResults
Text
[NodeWrap
(Module
Language
Language
(Compose ((,) (Int, Int)) (Compose Ambiguous ((,) ParsedLexemes)))
(Compose
((,) (Int, Int)) (Compose Ambiguous ((,) ParsedLexemes))))])
parseNamedModule LanguageVersion
version String
path Text
name =
do let basePath :: String
basePath = String -> ShowS
combine String
path (Text -> String
unpack Text
name)
Bool
isDefn <- String -> IO Bool
doesFileExist (String -> ShowS
addExtension String
basePath String
"Def")
let grammar :: Grammar (OberonGrammar Language NodeWrap) Parser Text
grammar = (if Bool
isDefn then LanguageVersion
-> Grammar (OberonGrammar Language NodeWrap) Parser Text
definitionGrammar else LanguageVersion
-> Grammar (OberonGrammar Language NodeWrap) Parser Text
moduleGrammar) LanguageVersion
version
Text
src <- String -> IO Text
readFile (String -> ShowS
addExtension String
basePath forall a b. (a -> b) -> a -> b
$ if Bool
isDefn then String
"Def" else String
"Mod")
forall (m :: * -> *) a. Monad m => a -> m a
return (forall {k1} {k2} (f :: k1 -> *) (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose forall a b. (a -> b) -> a -> b
$ forall (p :: * -> *) (q :: * -> *)
(g :: (* -> *) -> (* -> *) -> *).
(p ~ NodeWrap,
q
~ Compose ((,) (Int, Int)) (Compose Ambiguous ((,) ParsedLexemes)),
Functor (Map p q) g) =>
Text -> p (g p p) -> q (g q q)
Resolver.resolvePositions Text
src forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall {k1} {k2} (f :: k1 -> *) (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose forall a b. (a -> b) -> a -> b
$ forall l (f :: * -> *) (p :: * -> *).
OberonGrammar l f p -> p (f (Module l l f f))
Grammar.module_prod forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s (g :: (* -> *) -> *).
(MultiParsing m, ParserInput m ~ s, GrammarConstraint m g, Eq s,
FactorialMonoid s) =>
g m -> s -> g (ResultFunctor m)
parseComplete Grammar (OberonGrammar Language NodeWrap) Parser Text
grammar Text
src))
parseImportsOf :: LanguageVersion -> FilePath -> Map Text (NodeWrap (Module Language Language NodeWrap NodeWrap))
-> IO (Map Text (NodeWrap (Module Language Language NodeWrap NodeWrap)))
parseImportsOf :: LanguageVersion
-> String
-> Map
Text
(NodeWrap
(Module
Language
Language
(Compose ((,) (Int, Int)) (Compose Ambiguous ((,) ParsedLexemes)))
(Compose
((,) (Int, Int)) (Compose Ambiguous ((,) ParsedLexemes)))))
-> IO
(Map
Text
(NodeWrap
(Module
Language
Language
(Compose ((,) (Int, Int)) (Compose Ambiguous ((,) ParsedLexemes)))
(Compose
((,) (Int, Int)) (Compose Ambiguous ((,) ParsedLexemes))))))
parseImportsOf LanguageVersion
version String
path Map
Text
(NodeWrap
(Module
Language
Language
(Compose ((,) (Int, Int)) (Compose Ambiguous ((,) ParsedLexemes)))
(Compose
((,) (Int, Int)) (Compose Ambiguous ((,) ParsedLexemes)))))
modules =
case forall a. (a -> Bool) -> [a] -> [a]
filter (forall k a. Ord k => k -> Map k a -> Bool
`Map.notMember` Map
Text
(NodeWrap
(Module
Language
Language
(Compose ((,) (Int, Int)) (Compose Ambiguous ((,) ParsedLexemes)))
(Compose
((,) (Int, Int)) (Compose Ambiguous ((,) ParsedLexemes)))))
modules) [Text]
moduleImports
of [] -> forall (m :: * -> *) a. Monad m => a -> m a
return Map
Text
(NodeWrap
(Module
Language
Language
(Compose ((,) (Int, Int)) (Compose Ambiguous ((,) ParsedLexemes)))
(Compose
((,) (Int, Int)) (Compose Ambiguous ((,) ParsedLexemes)))))
modules
[Text]
newImports -> (((Map
Text
(NodeWrap
(Module
Language
Language
(Compose ((,) (Int, Int)) (Compose Ambiguous ((,) ParsedLexemes)))
(Compose
((,) (Int, Int)) (Compose Ambiguous ((,) ParsedLexemes)))))
modules forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall {a} {b}. (Text, Either a [b]) -> (Text, b)
assertSuccess) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
(forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse) (LanguageVersion
-> String
-> Text
-> IO
(ParseResults
Text
[NodeWrap
(Module
Language
Language
(Compose ((,) (Int, Int)) (Compose Ambiguous ((,) ParsedLexemes)))
(Compose
((,) (Int, Int)) (Compose Ambiguous ((,) ParsedLexemes))))])
parseNamedModule LanguageVersion
version String
path) [(Text
p, Text
p) | Text
p <- [Text]
newImports])
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= LanguageVersion
-> String
-> Map
Text
(NodeWrap
(Module
Language
Language
(Compose ((,) (Int, Int)) (Compose Ambiguous ((,) ParsedLexemes)))
(Compose
((,) (Int, Int)) (Compose Ambiguous ((,) ParsedLexemes)))))
-> IO
(Map
Text
(NodeWrap
(Module
Language
Language
(Compose ((,) (Int, Int)) (Compose Ambiguous ((,) ParsedLexemes)))
(Compose
((,) (Int, Int)) (Compose Ambiguous ((,) ParsedLexemes))))))
parseImportsOf LanguageVersion
version String
path
where moduleImports :: [Text]
moduleImports = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall {λ} {l} {f' :: * -> *} {f :: * -> *}.
Module λ l f' f -> [Text]
importsOf (forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose Map
Text
(NodeWrap
(Module
Language
Language
(Compose ((,) (Int, Int)) (Compose Ambiguous ((,) ParsedLexemes)))
(Compose
((,) (Int, Int)) (Compose Ambiguous ((,) ParsedLexemes)))))
modules)
importsOf :: Module λ l f' f -> [Text]
importsOf (Module Text
_ [Import l]
imports f (Block l l f' f')
_) = forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Import l]
imports
assertSuccess :: (Text, Either a [b]) -> (Text, b)
assertSuccess (Text
m, Left a
err) = forall a. HasCallStack => String -> a
error (String
"Parse error in module " forall a. Semigroup a => a -> a -> a
<> Text -> String
unpack Text
m)
assertSuccess (Text
m, Right [b
p]) = (Text
m, b
p)
assertSuccess (Text
m, Right [b]
_) = forall a. HasCallStack => String -> a
error (String
"Ambiguous parses of module " forall a. Semigroup a => a -> a -> a
<> Text -> String
unpack Text
m)
parseAndResolveModule :: Options -> FilePath -> Text
-> IO (Validation (Either (NonEmpty (Resolver.Error Language))
(NonEmpty (TypeChecker.Error Ident Language)))
(Placed (Module Language Language Placed Placed)))
parseAndResolveModule :: Options
-> String
-> Text
-> IO
(Validation
(Either
(NonEmpty (Error Language)) (NonEmpty (Error Text Language)))
(Placed (Module Language Language Parsed Parsed)))
parseAndResolveModule Options{Bool
LanguageVersion
version :: LanguageVersion
checkTypes :: Bool
foldConstants :: Bool
version :: Options -> LanguageVersion
checkTypes :: Options -> Bool
foldConstants :: Options -> Bool
..} String
path Text
source =
case LanguageVersion
-> Text
-> ParseResults
Text
[NodeWrap
(Module
Language
Language
(Compose ((,) (Int, Int)) (Compose Ambiguous ((,) ParsedLexemes)))
(Compose
((,) (Int, Int)) (Compose Ambiguous ((,) ParsedLexemes))))]
parseModule LanguageVersion
version Text
source
of Left ParseFailure Pos Text
err -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall e a. e -> Validation e a
Failure forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall l. Text -> Error l
Resolver.UnparseableModule (forall s pos.
(Ord s, TextualMonoid s, Position pos) =>
s -> ParseFailure pos s -> Int -> s
failureDescription Text
source ParseFailure Pos Text
err Int
4) forall a. a -> [a] -> NonEmpty a
:| [])
Right [rootModule :: NodeWrap
(Module
Language
Language
(Compose ((,) (Int, Int)) (Compose Ambiguous ((,) ParsedLexemes)))
(Compose ((,) (Int, Int)) (Compose Ambiguous ((,) ParsedLexemes))))
rootModule@(Compose ((Int, Int)
pos, Compose (Ambiguous ((ParsedLexemes
_, Module Text
moduleName [Import l]
imports NodeWrap
(Block
Language
Language
(Compose ((,) (Int, Int)) (Compose Ambiguous ((,) ParsedLexemes)))
(Compose ((,) (Int, Int)) (Compose Ambiguous ((,) ParsedLexemes))))
_) :| []))))] ->
do Map
Text
(NodeWrap
(Module
Language
Language
(Compose ((,) (Int, Int)) (Compose Ambiguous ((,) ParsedLexemes)))
(Compose
((,) (Int, Int)) (Compose Ambiguous ((,) ParsedLexemes)))))
importedModules <- LanguageVersion
-> String
-> Map
Text
(NodeWrap
(Module
Language
Language
(Compose ((,) (Int, Int)) (Compose Ambiguous ((,) ParsedLexemes)))
(Compose
((,) (Int, Int)) (Compose Ambiguous ((,) ParsedLexemes)))))
-> IO
(Map
Text
(NodeWrap
(Module
Language
Language
(Compose ((,) (Int, Int)) (Compose Ambiguous ((,) ParsedLexemes)))
(Compose
((,) (Int, Int)) (Compose Ambiguous ((,) ParsedLexemes))))))
parseImportsOf LanguageVersion
version String
path (forall k a. k -> a -> Map k a
Map.singleton Text
moduleName NodeWrap
(Module
Language
Language
(Compose ((,) (Int, Int)) (Compose Ambiguous ((,) ParsedLexemes)))
(Compose ((,) (Int, Int)) (Compose Ambiguous ((,) ParsedLexemes))))
rootModule)
let resolvedImportMap :: Map
Text
(Validation
(NonEmpty (Error Language))
(Placed (Module Language Language Parsed Parsed)))
resolvedImportMap = forall l.
(BindableDeclaration l, CoFormalParameters l,
Traversable (Resolution l) (Module l l),
Traversable (Resolution l) (Block l l),
Traversable (Resolution l) (Declaration l l),
Traversable (Resolution l) (Type l l),
Traversable (Resolution l) (FormalParameters l l),
Traversable (Resolution l) (ConstExpression l l),
Traversable (Resolution l) (StatementSequence l l),
Traversable (Resolution l) (Declaration l l),
Traversable (Resolution l) (DeclarationRHS l),
Traversable (Resolution l) (Declaration l l),
Traversable (Resolution l) (StatementSequence l l),
Traversable (Resolution l) (Type l l),
Traversable (Resolution l) (FormalParameters l l),
Traversable (Resolution l) (ConstExpression l l),
At
(Resolution l)
(Block
l
l
(Compose ((,) (Int, Int)) (Compose Ambiguous ((,) ParsedLexemes)))
(Compose
((,) (Int, Int)) (Compose Ambiguous ((,) ParsedLexemes))))) =>
Scope l
-> Map
Text
(Validation
(NonEmpty (Error l)) (Placed (Module l l Parsed Parsed)))
-> NodeWrap
(Module
l
l
(Compose ((,) (Int, Int)) (Compose Ambiguous ((,) ParsedLexemes)))
(Compose ((,) (Int, Int)) (Compose Ambiguous ((,) ParsedLexemes))))
-> Validation
(NonEmpty (Error l)) (Placed (Module l l Parsed Parsed))
Resolver.resolveModule Predefined Language
predefinedScope Map
Text
(Validation
(NonEmpty (Error Language))
(Placed (Module Language Language Parsed Parsed)))
resolvedImportMap forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map
Text
(NodeWrap
(Module
Language
Language
(Compose ((,) (Int, Int)) (Compose Ambiguous ((,) ParsedLexemes)))
(Compose
((,) (Int, Int)) (Compose Ambiguous ((,) ParsedLexemes)))))
importedModules
predefinedScope :: Predefined Language
predefinedScope = case LanguageVersion
version
of LanguageVersion
Oberon1 -> forall l. Oberon l => Predefined l
Resolver.predefined
LanguageVersion
Oberon2 -> forall l. Oberon l => Predefined l
Resolver.predefined2
successful :: Validation e a -> Maybe a
successful (Success a
a) = forall a. a -> Maybe a
Just a
a
successful Validation e a
_ = forall a. Maybe a
Nothing
addLeft :: Validation a a -> Validation (Either a b) a
addLeft (Failure a
resolutionErrors) = forall e a. e -> Validation e a
Failure (forall a b. a -> Either a b
Left a
resolutionErrors)
addLeft (Success a
result) = forall e a. a -> Validation e a
Success a
result
constantFolded :: Map Text (Placed (Module Language Language Parsed Parsed))
constantFolded = forall (g :: (* -> *) -> (* -> *) -> *).
(Foldable (g (Const (Sum Int))),
Foldable (Fold Parsed (Sum Int)) g,
Traversable PositionAdjustment g) =>
Parsed (g Parsed Parsed) -> Parsed (g Parsed Parsed)
Reserializer.adjustPositions forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
forall l.
(Oberon l, Nameable l, Ord (QualIdent l), Show (QualIdent l),
Atts (Inherited (Auto ConstantFold)) (Block l l Sem Sem) ~ InhCF l,
Atts (Synthesized (Auto ConstantFold)) (Block l l Sem Sem)
~ SynCFMod' l (Block l l),
Functor (Auto ConstantFold) (Block l l),
Functor (Auto ConstantFold) (Block l l)) =>
Environment l
-> Map Text (Placed (Module l l Parsed Parsed))
-> Map Text (Placed (Module l l Parsed Parsed))
ConstantFolder.foldConstants
(case LanguageVersion
version
of LanguageVersion
Oberon1 -> forall l. (Wirthy l, Ord (QualIdent l)) => Environment l
ConstantFolder.predefined
LanguageVersion
Oberon2 -> forall l. (Wirthy l, Ord (QualIdent l)) => Environment l
ConstantFolder.predefined2)
(forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe forall {e} {a}. Validation e a -> Maybe a
successful Map
Text
(Validation
(NonEmpty (Error Language))
(Placed (Module Language Language Parsed Parsed)))
resolvedImportMap)
typeErrors :: [Error Text Language]
typeErrors = forall l.
(Oberon l, Nameable l, Ord (QualIdent l), Show (QualIdent l),
Atts (Inherited (Auto TypeCheck)) (Block l l Sem Sem) ~ InhTC l,
Atts (Synthesized (Auto TypeCheck)) (Block l l Sem Sem)
~ SynTCMod l,
Functor (Auto TypeCheck) (Block l l)) =>
Environment l
-> Map Text (Placed (Module l l Parsed Parsed)) -> [Error Text l]
TypeChecker.checkModules
(case LanguageVersion
version
of LanguageVersion
Oberon1 -> forall l. (Wirthy l, Ord (QualIdent l)) => Environment l
TypeChecker.predefined
LanguageVersion
Oberon2 -> forall l. (Wirthy l, Ord (QualIdent l)) => Environment l
TypeChecker.predefined2)
Map Text (Placed (Module Language Language Parsed Parsed))
constantFolded
forall (m :: * -> *) a. Monad m => a -> m a
return (if Bool
checkTypes Bool -> Bool -> Bool
&& Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Error Text Language]
typeErrors)
then forall e a. e -> Validation e a
Failure (forall a b. b -> Either a b
Right (forall a. [a] -> NonEmpty a
NonEmpty.fromList [Error Text Language]
typeErrors))
else forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall {a} {a} {b}. Validation a a -> Validation (Either a b) a
addLeft forall a b. (a -> b) -> a -> b
$ Map
Text
(Validation
(NonEmpty (Error Language))
(Placed (Module Language Language Parsed Parsed)))
resolvedImportMap forall k a. Ord k => Map k a -> k -> a
Map.! Text
moduleName) forall e a. a -> Validation e a
Success
(forall (f :: * -> *). Alternative f => Bool -> f ()
guard Bool
foldConstants forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
moduleName Map Text (Placed (Module Language Language Parsed Parsed))
constantFolded))
Right [NodeWrap
(Module
Language
Language
(Compose ((,) (Int, Int)) (Compose Ambiguous ((,) ParsedLexemes)))
(Compose
((,) (Int, Int)) (Compose Ambiguous ((,) ParsedLexemes))))]
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall e a. e -> Validation e a
Failure forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall l. Error l
Resolver.AmbiguousParses forall a. a -> [a] -> NonEmpty a
:| [])
parseAndResolveModuleFile :: Options -> FilePath
-> IO (Validation (Either (NonEmpty (Resolver.Error Language))
(NonEmpty (TypeChecker.Error Ident Language)))
(Placed (Module Language Language Placed Placed)))
parseAndResolveModuleFile :: Options
-> String
-> IO
(Validation
(Either
(NonEmpty (Error Language)) (NonEmpty (Error Text Language)))
(Placed (Module Language Language Parsed Parsed)))
parseAndResolveModuleFile Options
options String
path =
String -> IO Text
readFile String
path forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Options
-> String
-> Text
-> IO
(Validation
(Either
(NonEmpty (Error Language)) (NonEmpty (Error Text Language)))
(Placed (Module Language Language Parsed Parsed)))
parseAndResolveModule Options
options (ShowS
takeDirectory String
path)