{-# LANGUAGE FlexibleContexts, FlexibleInstances, KindSignatures, MultiParamTypeClasses, OverloadedStrings,
ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TypeFamilies, TypeOperators,
UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-simplifiable-class-constraints #-}
module Language.Oberon.Resolver (resolveModules, resolveModule, resolvePositions, resolvePosition,
Error(..), Predefined, Placed, NodeWrap, predefined, predefined2) where
import Control.Applicative (ZipList(ZipList, getZipList))
import Control.Arrow (first)
import Control.Monad.Trans.State (StateT(..), evalStateT, execStateT, get, put)
import Data.Either (partitionEithers)
import Data.Either.Validation (Validation(..), validationToEither)
import Data.Foldable (toList)
import Data.Functor.Compose (Compose(..))
import Data.List.NonEmpty (NonEmpty(..))
import qualified Data.List.NonEmpty as NonEmpty
import qualified Data.List as List
import Data.Map.Lazy (Map, traverseWithKey)
import qualified Data.Map.Lazy as Map
import Data.Semigroup (Semigroup(..), sconcat)
import Data.Text (Text)
import Language.Haskell.TH (appT, conT, varT, newName)
import qualified Text.Parser.Input.Position as Position
import qualified Rank2.TH
import qualified Transformation
import qualified Transformation.Deep as Deep
import qualified Transformation.Deep.TH
import qualified Transformation.Full as Full
import qualified Transformation.Full.TH
import qualified Transformation.Rank2 as Rank2
import Text.Grampa (Ambiguous(..))
import qualified Language.Oberon.Abstract as Abstract
import Language.Oberon.AST
import Language.Oberon.Grammar (ParsedLexemes(Trailing))
import qualified Language.Oberon.Grammar as Grammar
resolvePositions :: (p ~ Grammar.NodeWrap, q ~ NodeWrap, Deep.Functor (Rank2.Map p q) g)
=> Text -> p (g p p) -> q (g q q)
resolvePositions :: forall (p :: * -> *) (q :: * -> *)
(g :: (* -> *) -> (* -> *) -> *).
(p ~ NodeWrap, q ~ NodeWrap, Functor (Map p q) g) =>
Text -> p (g p p) -> q (g q q)
resolvePositions Text
src p (g p p)
t = forall (p :: * -> *) (q :: * -> *).
(forall x. p x -> q x) -> Map p q
Rank2.Map (forall a. Text -> NodeWrap a -> NodeWrap a
resolvePosition Text
src) forall t (g :: (* -> *) -> (* -> *) -> *).
Functor t g =>
t
-> Domain t (g (Domain t) (Domain t))
-> Codomain t (g (Codomain t) (Codomain t))
Full.<$> p (g p p)
t
resolvePosition :: Text -> Grammar.NodeWrap a -> NodeWrap a
resolvePosition :: forall a. Text -> NodeWrap a -> NodeWrap a
resolvePosition Text
src = \(Compose ((Down Int
start, Down Int
end), Compose Ambiguous ((,) ParsedLexemes) a
a))-> forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose ((forall p s. (Position p, FactorialMonoid s) => s -> p -> Int
Position.offset Text
src Down Int
start, forall p s. (Position p, FactorialMonoid s) => s -> p -> Int
Position.offset Text
src Down Int
end), Compose Ambiguous ((,) ParsedLexemes) a
a)
data DeclarationRHS l f' f = DeclaredConstant (f (Abstract.ConstExpression l l f' f'))
| DeclaredType (f (Abstract.Type l l f' f'))
| DeclaredVariable (f (Abstract.Type l l f' f'))
| DeclaredProcedure Bool (Maybe (f (Abstract.FormalParameters l l f' f')))
deriving instance (Show (Abstract.FormalParameters l l Placed Placed), Show (Abstract.Type l l Placed Placed),
Show (Abstract.ConstExpression l l Placed Placed)) =>
Show (DeclarationRHS l Placed Placed)
deriving instance (Show (Abstract.FormalParameters l l NodeWrap NodeWrap), Show (Abstract.Type l l NodeWrap NodeWrap),
Show (Abstract.ConstExpression l l NodeWrap NodeWrap)) =>
Show (DeclarationRHS l NodeWrap NodeWrap)
data Error l = UnknownModule (Abstract.QualIdent l)
| UnknownLocal Ident
| UnknownImport (Abstract.QualIdent l)
| AmbiguousParses
| AmbiguousDeclaration [Declaration l l NodeWrap NodeWrap]
| AmbiguousDesignator [Designator l l NodeWrap NodeWrap]
| AmbiguousExpression [Expression l l NodeWrap NodeWrap]
| AmbiguousRecord [Designator l l NodeWrap NodeWrap]
| AmbiguousStatement [Statement l l NodeWrap NodeWrap]
| InvalidExpression (NonEmpty (Error l))
| InvalidFunctionParameters [NodeWrap (Abstract.Expression l l NodeWrap NodeWrap)]
| InvalidRecord (NonEmpty (Error l))
| InvalidStatement (NonEmpty (Error l))
| NotARecord (Abstract.QualIdent l)
| NotAType (Abstract.QualIdent l)
| NotAValue (Abstract.QualIdent l)
| ClashingImports
| UnparseableModule Text
deriving instance (Show (Abstract.QualIdent l),
Show (Declaration l l NodeWrap NodeWrap), Show (Statement l l NodeWrap NodeWrap),
Show (Expression l l NodeWrap NodeWrap), Show (Abstract.Expression l l NodeWrap NodeWrap),
Show (Designator l l NodeWrap NodeWrap)) => Show (Error l)
type Placed = (,) (Int, ParsedLexemes, Int)
type NodeWrap = Compose ((,) (Int, Int)) (Compose Ambiguous ((,) ParsedLexemes))
type Scope l = Map Ident (Validation (NonEmpty (Error l)) (DeclarationRHS l Placed Placed))
type Predefined l = Scope l
data Resolution l = Resolution{forall l. Resolution l -> Map Text (Scope l)
_modules :: Map Ident (Scope l)}
type Resolved l = StateT (Scope l, ResolutionState) (Validation (NonEmpty (Error l)))
data ResolutionState = ModuleState
| DeclarationState
| StatementState
| ExpressionState
| ExpressionOrTypeState
deriving (ResolutionState -> ResolutionState -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ResolutionState -> ResolutionState -> Bool
$c/= :: ResolutionState -> ResolutionState -> Bool
== :: ResolutionState -> ResolutionState -> Bool
$c== :: ResolutionState -> ResolutionState -> Bool
Eq, Int -> ResolutionState -> ShowS
[ResolutionState] -> ShowS
ResolutionState -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ResolutionState] -> ShowS
$cshowList :: [ResolutionState] -> ShowS
show :: ResolutionState -> String
$cshow :: ResolutionState -> String
showsPrec :: Int -> ResolutionState -> ShowS
$cshowsPrec :: Int -> ResolutionState -> ShowS
Show)
instance Monad (Validation (NonEmpty (Error l))) where
Success a
s >>= :: forall a b.
Validation (NonEmpty (Error l)) a
-> (a -> Validation (NonEmpty (Error l)) b)
-> Validation (NonEmpty (Error l)) b
>>= a -> Validation (NonEmpty (Error l)) b
f = a -> Validation (NonEmpty (Error l)) b
f a
s
Failure NonEmpty (Error l)
errors >>= a -> Validation (NonEmpty (Error l)) b
_ = forall e a. e -> Validation e a
Failure NonEmpty (Error l)
errors
instance Transformation.Transformation (Resolution l) where
type Domain (Resolution l) = NodeWrap
type Codomain (Resolution l) = Compose (Resolved l) Placed
instance {-# overlappable #-} Resolution l `Transformation.At` g Placed Placed where
$ :: Resolution l
-> Domain (Resolution l) (g Placed Placed)
-> Codomain (Resolution l) (g Placed Placed)
($) = forall l (g :: (* -> *) -> (* -> *) -> *) (f :: * -> *).
Resolution l
-> NodeWrap (g f f) -> Compose (Resolved l) Placed (g f f)
traverseResolveDefault
instance {-# overlappable #-} Resolution l `Transformation.At` g NodeWrap NodeWrap where
$ :: Resolution l
-> Domain (Resolution l) (g NodeWrap NodeWrap)
-> Codomain (Resolution l) (g NodeWrap NodeWrap)
($) = forall l (g :: (* -> *) -> (* -> *) -> *) (f :: * -> *).
Resolution l
-> NodeWrap (g f f) -> Compose (Resolved l) Placed (g f f)
traverseResolveDefault
instance {-# overlaps #-} Resolvable l => Resolution l `Transformation.At` Designator l l NodeWrap NodeWrap where
Resolution l
res $ :: Resolution l
-> Domain (Resolution l) (Designator l l NodeWrap NodeWrap)
-> Codomain (Resolution l) (Designator l l NodeWrap NodeWrap)
$ Compose ((Int
start, Int
end), Compose (Ambiguous NonEmpty (ParsedLexemes, Designator l l NodeWrap NodeWrap)
designators)) = forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT forall a b. (a -> b) -> a -> b
$ \s :: (Scope l, ResolutionState)
s@(Scope l
scope, ResolutionState
state)->
case forall a b. [Either a b] -> ([a], [b])
partitionEithers (forall a. NonEmpty a -> [a]
NonEmpty.toList (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall e a. Validation e a -> Either e a
validationToEither forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l.
Resolvable l =>
Resolution l
-> Scope l
-> ResolutionState
-> Designator l l NodeWrap NodeWrap
-> Validation
(NonEmpty (Error l)) (Designator l l NodeWrap NodeWrap)
resolveDesignator Resolution l
res Scope l
scope ResolutionState
state)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (ParsedLexemes, Designator l l NodeWrap NodeWrap)
designators))
of ([NonEmpty (Error l)]
_, [(ParsedLexemes
ws, Designator l l NodeWrap NodeWrap
x)]) -> forall e a. a -> Validation e a
Success (((Int
start, ParsedLexemes
ws, Int
end), Designator l l NodeWrap NodeWrap
x), (Scope l, ResolutionState)
s)
([NonEmpty (Error l)]
errors, []) -> forall e a. e -> Validation e a
Failure (forall a. Semigroup a => NonEmpty a -> a
sconcat forall a b. (a -> b) -> a -> b
$ forall a. [a] -> NonEmpty a
NonEmpty.fromList [NonEmpty (Error l)]
errors)
([NonEmpty (Error l)]
_, [(ParsedLexemes, Designator l l NodeWrap NodeWrap)]
multi) -> forall e a. e -> Validation e a
Failure (forall l. [Designator l l NodeWrap NodeWrap] -> Error l
AmbiguousDesignator (forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(ParsedLexemes, Designator l l NodeWrap NodeWrap)]
multi) forall a. a -> [a] -> NonEmpty a
:| [])
class Readable l where
getVariableName :: Abstract.Designator l l f' f -> Maybe (Abstract.QualIdent l)
instance Readable Language where
getVariableName :: forall (f' :: * -> *) (f :: * -> *).
Designator Language Language f' f -> Maybe (QualIdent Language)
getVariableName (Variable QualIdent Language
q) = forall a. a -> Maybe a
Just QualIdent Language
q
getVariableName Designator Language Language f' f
_ = forall a. Maybe a
Nothing
instance {-# overlaps #-}
(Readable l, Abstract.Nameable l, Abstract.Oberon l,
Deep.Traversable (Resolution l) (Abstract.Expression l l),
Deep.Traversable (Resolution l) (Abstract.Designator l l),
Resolution l `Transformation.At` Abstract.Expression l l NodeWrap NodeWrap,
Resolution l `Transformation.At` Abstract.Designator l l NodeWrap NodeWrap) =>
Resolution l `Transformation.At` Expression l l NodeWrap NodeWrap where
Resolution l
res $ :: Resolution l
-> Domain (Resolution l) (Expression l l NodeWrap NodeWrap)
-> Codomain (Resolution l) (Expression l l NodeWrap NodeWrap)
$ Domain (Resolution l) (Expression l l NodeWrap NodeWrap)
expressions = forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT forall a b. (a -> b) -> a -> b
$ \s :: (Scope l, ResolutionState)
s@(Scope l
scope, ResolutionState
state)->
let resolveExpression :: Expression l l NodeWrap NodeWrap
-> Validation (NonEmpty (Error l)) (Expression l l NodeWrap NodeWrap, ResolutionState)
resolveExpression :: Expression l l NodeWrap NodeWrap
-> Validation
(NonEmpty (Error l))
(Expression l l NodeWrap NodeWrap, ResolutionState)
resolveExpression e :: Expression l l NodeWrap NodeWrap
e@(Read NodeWrap (Designator l l NodeWrap NodeWrap)
designators) =
case forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (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
$ Resolution l
res forall t x. At t x => t -> Domain t x -> Codomain t x
Transformation.$ NodeWrap (Designator l l NodeWrap NodeWrap)
designators) (Scope l, ResolutionState)
s
of Failure NonEmpty (Error l)
errors -> forall e a. e -> Validation e a
Failure NonEmpty (Error l)
errors
Success{} -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expression l l NodeWrap NodeWrap
e, ResolutionState
state)
resolveExpression e :: Expression l l NodeWrap NodeWrap
e@(FunctionCall NodeWrap (Designator l l NodeWrap NodeWrap)
functions ZipList (NodeWrap (Expression l l NodeWrap NodeWrap))
parameters) =
case forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (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
$ Resolution l
res forall t x. At t x => t -> Domain t x -> Codomain t x
Transformation.$ NodeWrap (Designator l l NodeWrap NodeWrap)
functions) (Scope l, ResolutionState)
s
of Failure NonEmpty (Error l)
errors -> forall e a. e -> Validation e a
Failure NonEmpty (Error l)
errors
Success ((Int, ParsedLexemes, Int)
_pos, Designator l l NodeWrap NodeWrap
d)
| Just QualIdent l
q <- forall l (f' :: * -> *) (f :: * -> *).
Readable l =>
Designator l l f' f -> Maybe (QualIdent l)
getVariableName Designator l l NodeWrap NodeWrap
d, Success (DeclaredProcedure Bool
True Maybe (Placed (FormalParameters l l Placed Placed))
_) <- forall l.
(Nameable l, Oberon l) =>
Resolution l
-> Scope l
-> QualIdent l
-> Validation (NonEmpty (Error l)) (DeclarationRHS l Placed Placed)
resolveName Resolution l
res Scope l
scope QualIdent l
q
-> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expression l l NodeWrap NodeWrap
e, ResolutionState
ExpressionOrTypeState)
| Success{} <- forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall {k1} {k2} (f :: k1 -> *) (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Resolution l
res forall t x. At t x => t -> Domain t x -> Codomain t x
Transformation.$)) ZipList (NodeWrap (Expression l l NodeWrap NodeWrap))
parameters)
(Scope l
scope, ResolutionState
ExpressionState)
-> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expression l l NodeWrap NodeWrap
e, ResolutionState
ExpressionState)
| Bool
otherwise -> forall e a. e -> Validation e a
Failure (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall l. [NodeWrap (Expression l l NodeWrap NodeWrap)] -> Error l
InvalidFunctionParameters forall a b. (a -> b) -> a -> b
$ forall a. ZipList a -> [a]
getZipList ZipList (NodeWrap (Expression l l NodeWrap NodeWrap))
parameters)
resolveExpression e :: Expression l l NodeWrap NodeWrap
e@(IsA NodeWrap (Expression l l NodeWrap NodeWrap)
_lefts QualIdent l
q) =
case forall l.
(Nameable l, Oberon l) =>
Resolution l
-> Scope l
-> QualIdent l
-> Validation (NonEmpty (Error l)) (DeclarationRHS l Placed Placed)
resolveName Resolution l
res Scope l
scope QualIdent l
q
of Failure NonEmpty (Error l)
err -> forall e a. e -> Validation e a
Failure NonEmpty (Error l)
err
Success DeclaredType{} -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expression l l NodeWrap NodeWrap
e, ResolutionState
ExpressionState)
Success DeclarationRHS l Placed Placed
_ -> forall e a. e -> Validation e a
Failure (forall l. QualIdent l -> Error l
NotAType QualIdent l
q forall a. a -> [a] -> NonEmpty a
:| [])
resolveExpression Expression l l NodeWrap NodeWrap
e = forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expression l l NodeWrap NodeWrap
e, ResolutionState
state)
in (\((Int, ParsedLexemes, Int)
pos, (Expression l l NodeWrap NodeWrap
r, ResolutionState
s'))-> (((Int, ParsedLexemes, Int)
pos, Expression l l NodeWrap NodeWrap
r), (Scope l
scope, ResolutionState
s')))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall l a.
(NonEmpty (Error l) -> Error l)
-> ([a] -> Error l)
-> NodeWrap (Validation (NonEmpty (Error l)) a)
-> Validation (NonEmpty (Error l)) (Placed a)
unique forall l. NonEmpty (Error l) -> Error l
InvalidExpression (forall l. [Expression l l NodeWrap NodeWrap] -> Error l
AmbiguousExpression forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>)) (Expression l l NodeWrap NodeWrap
-> Validation
(NonEmpty (Error l))
(Expression l l NodeWrap NodeWrap, ResolutionState)
resolveExpression forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Domain (Resolution l) (Expression l l NodeWrap NodeWrap)
expressions)
instance {-# overlaps #-}
(BindableDeclaration l, CoFormalParameters l, Abstract.Wirthy l,
Full.Traversable (Resolution l) (Abstract.Type l l),
Full.Traversable (Resolution l) (Abstract.FormalParameters l l),
Full.Traversable (Resolution l) (Abstract.ConstExpression l l),
Deep.Traversable (Resolution l) (DeclarationRHS l),
Deep.Traversable (Resolution l) (Abstract.Type l l),
Deep.Traversable (Resolution l) (Abstract.ProcedureHeading l l),
Deep.Traversable (Resolution l) (Abstract.FormalParameters l l),
Deep.Traversable (Resolution l) (Abstract.ConstExpression l l),
Resolution l `Transformation.At` Abstract.ProcedureHeading l l NodeWrap NodeWrap,
Resolution l `Transformation.At` Abstract.Block l l NodeWrap NodeWrap) =>
Resolution l `Transformation.At` Declaration l l NodeWrap NodeWrap where
Resolution l
res $ :: Resolution l
-> Domain (Resolution l) (Declaration l l NodeWrap NodeWrap)
-> Codomain (Resolution l) (Declaration l l NodeWrap NodeWrap)
$ Compose ((Int
start, Int
end), Compose (Ambiguous ((ParsedLexemes
ws, proc :: Declaration l l NodeWrap NodeWrap
proc@(ProcedureDeclaration NodeWrap (ProcedureHeading l l NodeWrap NodeWrap)
heading NodeWrap (Block l l NodeWrap NodeWrap)
body)) :| []))) =
forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose forall a b. (a -> b) -> a -> b
$
do s :: (Map
Text
(Validation (NonEmpty (Error l)) (DeclarationRHS l Placed Placed)),
ResolutionState)
s@(Map
Text
(Validation (NonEmpty (Error l)) (DeclarationRHS l Placed Placed))
scope, ResolutionState
state) <- forall (m :: * -> *) s. Monad m => StateT s m s
get
let Success (Map
Text
(Validation (NonEmpty (Error l)) (DeclarationRHS l Placed Placed))
headingScope, ResolutionState
_) = forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
execStateT (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
$ Resolution l
res forall t x. At t x => t -> Domain t x -> Codomain t x
Transformation.$ NodeWrap (ProcedureHeading l l NodeWrap NodeWrap)
heading) (Map
Text
(Validation (NonEmpty (Error l)) (DeclarationRHS l Placed Placed)),
ResolutionState)
s
Success ((Int, ParsedLexemes, Int)
_, Block l l NodeWrap NodeWrap
body') = forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (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
$ Resolution l
res forall t x. At t x => t -> Domain t x -> Codomain t x
Transformation.$ NodeWrap (Block l l NodeWrap NodeWrap)
body) (Map
Text
(Validation (NonEmpty (Error l)) (DeclarationRHS l Placed Placed)),
ResolutionState)
s
innerScope :: Map
Text
(Validation (NonEmpty (Error l)) (DeclarationRHS l Placed Placed))
innerScope = forall l.
(BindableDeclaration l,
Traversable (Resolution l) (DeclarationRHS l),
Traversable (Resolution l) (Type l l),
Traversable (Resolution l) (FormalParameters l l),
Traversable (Resolution l) (ConstExpression l l)) =>
Resolution l
-> Text
-> [NodeWrap (Declaration l l NodeWrap NodeWrap)]
-> Scope l
-> Scope l
localScope Resolution l
res Text
"" (forall l (f' :: * -> *) (f :: * -> *).
CoFormalParameters l =>
Block l l f' f -> [f (Declaration l l f' f')]
getLocalDeclarations Block l l NodeWrap NodeWrap
body') (Map
Text
(Validation (NonEmpty (Error l)) (DeclarationRHS l Placed Placed))
headingScope forall k a. Ord k => Map k a -> Map k a -> Map k a
`Map.union` Map
Text
(Validation (NonEmpty (Error l)) (DeclarationRHS l Placed Placed))
scope)
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put (Map
Text
(Validation (NonEmpty (Error l)) (DeclarationRHS l Placed Placed))
innerScope, ResolutionState
state)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Int
start, ParsedLexemes
ws, Int
end), Declaration l l NodeWrap NodeWrap
proc)
Resolution l
_ $ Compose ((Int
start, Int
end), Compose (Ambiguous ((ParsedLexemes
ws, Declaration l l NodeWrap NodeWrap
dec) :| []))) = forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Int
start, ParsedLexemes
ws, Int
end), Declaration l l NodeWrap NodeWrap
dec))
Resolution l
_ $ Domain (Resolution l) (Declaration l l NodeWrap NodeWrap)
declarations = forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall e a. e -> Validation e a
Failure forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall l. [Declaration l l NodeWrap NodeWrap] -> Error l
AmbiguousDeclaration forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Domain (Resolution l) (Declaration l l NodeWrap NodeWrap)
declarations)
class CoFormalParameters l where
getFPSections :: Abstract.FormalParameters l l f' f -> [f (Abstract.FPSection l l f' f')]
evalFPSection :: Abstract.FPSection l l f' f -> (Bool -> [Ident] -> f (Abstract.Type l l f' f') -> r) -> r
getLocalDeclarations :: Abstract.Block l l f' f -> [f (Abstract.Declaration l l f' f')]
instance CoFormalParameters Language where
getFPSections :: forall (f' :: * -> *) (f :: * -> *).
FormalParameters Language Language f' f
-> [f (FPSection Language Language f' f')]
getFPSections (FormalParameters ZipList (f (FPSection Language Language f' f'))
sections Maybe (QualIdent Language)
_) = forall a. ZipList a -> [a]
getZipList ZipList (f (FPSection Language Language f' f'))
sections
evalFPSection :: forall (f' :: * -> *) (f :: * -> *) r.
FPSection Language Language f' f
-> (Bool -> [Text] -> f (Type Language Language f' f') -> r) -> r
evalFPSection (FPSection Bool
var [Text]
names f (Type Language Language f' f')
types) Bool -> [Text] -> f (Type Language Language f' f') -> r
f = Bool -> [Text] -> f (Type Language Language f' f') -> r
f Bool
var [Text]
names f (Type Language Language f' f')
types
getLocalDeclarations :: forall (f' :: * -> *) (f :: * -> *).
Block Language Language f' f
-> [f (Declaration Language Language f' f')]
getLocalDeclarations (Block ZipList (f (Declaration Language Language f' f'))
declarations Maybe (f (StatementSequence Language Language f' f'))
_statements) = forall a. ZipList a -> [a]
getZipList ZipList (f (Declaration Language Language f' f'))
declarations
instance {-# overlaps #-}
(Abstract.Wirthy l, CoFormalParameters l,
Full.Traversable (Resolution l) (Abstract.Type l l),
Full.Traversable (Resolution l) (Abstract.FormalParameters l l),
Full.Traversable (Resolution l) (Abstract.ConstExpression l l),
Deep.Traversable (Resolution l) (DeclarationRHS l),
Deep.Traversable (Resolution l) (Abstract.Type l l),
Deep.Traversable (Resolution l) (Abstract.FormalParameters l l),
Deep.Traversable (Resolution l) (Abstract.ConstExpression l l)) =>
Resolution l `Transformation.At` ProcedureHeading l l NodeWrap NodeWrap where
Resolution l
res $ :: Resolution l
-> Domain (Resolution l) (ProcedureHeading l l NodeWrap NodeWrap)
-> Codomain (Resolution l) (ProcedureHeading l l NodeWrap NodeWrap)
$ Compose ((Int
start, Int
end), Compose (Ambiguous ((ParsedLexemes
ws, proc :: ProcedureHeading l l NodeWrap NodeWrap
proc@(ProcedureHeading Bool
_ IdentDef l
_ Maybe
(Compose
((,) (Int, Int))
(Compose Ambiguous ((,) ParsedLexemes))
(FormalParameters l l NodeWrap NodeWrap))
parameters)) :| []))) =
forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT forall a b. (a -> b) -> a -> b
$ \s :: (Map
Text
(Validation (NonEmpty (Error l)) (DeclarationRHS l Placed Placed)),
ResolutionState)
s@(Map
Text
(Validation (NonEmpty (Error l)) (DeclarationRHS l Placed Placed))
scope, ResolutionState
state)->
let innerScope :: Map
Text
(Validation (NonEmpty (Error l)) (DeclarationRHS l Placed Placed))
innerScope = Map
Text
(Validation (NonEmpty (Error l)) (DeclarationRHS l Placed Placed))
parameterScope forall k a. Ord k => Map k a -> Map k a -> Map k a
`Map.union` Map
Text
(Validation (NonEmpty (Error l)) (DeclarationRHS l Placed Placed))
scope
parameterScope :: Map
Text
(Validation (NonEmpty (Error l)) (DeclarationRHS l Placed Placed))
parameterScope = case Maybe
(Compose
((,) (Int, Int))
(Compose Ambiguous ((,) ParsedLexemes))
(FormalParameters l l NodeWrap NodeWrap))
parameters
of Maybe
(Compose
((,) (Int, Int))
(Compose Ambiguous ((,) ParsedLexemes))
(FormalParameters l l NodeWrap NodeWrap))
Nothing -> forall a. Monoid a => a
mempty
Just (Compose ((Int, Int)
_, Compose (Ambiguous ((ParsedLexemes
ws, FormalParameters l l NodeWrap NodeWrap
fp) :| [])))) | [Compose
((,) (Int, Int))
(Compose Ambiguous ((,) ParsedLexemes))
(FPSection l l NodeWrap NodeWrap)]
sections <- forall l (f' :: * -> *) (f :: * -> *).
CoFormalParameters l =>
FormalParameters l l f' f -> [f (FPSection l l f' f')]
getFPSections FormalParameters l l NodeWrap NodeWrap
fp
-> forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Compose
((,) (Int, Int))
(Compose Ambiguous ((,) ParsedLexemes))
(FPSection l l NodeWrap NodeWrap)
-> [(Text,
Validation (NonEmpty (Error l)) (DeclarationRHS l Placed Placed))]
binding [Compose
((,) (Int, Int))
(Compose Ambiguous ((,) ParsedLexemes))
(FPSection l l NodeWrap NodeWrap)]
sections)
binding :: Compose
((,) (Int, Int))
(Compose Ambiguous ((,) ParsedLexemes))
(FPSection l l NodeWrap NodeWrap)
-> [(Text,
Validation (NonEmpty (Error l)) (DeclarationRHS l Placed Placed))]
binding (Compose ((Int, Int)
_, Compose (Ambiguous ((ParsedLexemes
_, FPSection l l NodeWrap NodeWrap
section) :| [])))) = forall l (f' :: * -> *) (f :: * -> *) r.
CoFormalParameters l =>
FPSection l l f' f
-> (Bool -> [Text] -> f (Type l l f' f') -> r) -> r
evalFPSection FPSection l l NodeWrap NodeWrap
section forall a b. (a -> b) -> a -> b
$ \ Bool
_ [Text]
names NodeWrap (Type l l NodeWrap NodeWrap)
types->
[(Text
v, forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (forall t (g :: (* -> *) -> (* -> *) -> *) (m :: * -> *)
(f :: * -> *).
(Traversable t g, Codomain t ~ Compose m f) =>
t -> g (Domain t) (Domain t) -> m (g f f)
Deep.traverse Resolution l
res forall a b. (a -> b) -> a -> b
$ forall l (f' :: * -> *) (f :: * -> *).
f (Type l l f' f') -> DeclarationRHS l f' f
DeclaredVariable NodeWrap (Type l l NodeWrap NodeWrap)
types) (Map
Text
(Validation (NonEmpty (Error l)) (DeclarationRHS l Placed Placed)),
ResolutionState)
s) | Text
v <- [Text]
names]
in forall e a. a -> Validation e a
Success (((Int
start, ParsedLexemes
ws, Int
end), ProcedureHeading l l NodeWrap NodeWrap
proc), (Map
Text
(Validation (NonEmpty (Error l)) (DeclarationRHS l Placed Placed))
innerScope, ResolutionState
state))
Resolution l
res $ Compose ((Int
start, Int
end),
Compose (Ambiguous ((ParsedLexemes
ws, proc :: ProcedureHeading l l NodeWrap NodeWrap
proc@(TypeBoundHeading Bool
_var Text
receiverName Text
receiverType Bool
_ IdentDef l
_ Maybe
(Compose
((,) (Int, Int))
(Compose Ambiguous ((,) ParsedLexemes))
(FormalParameters l l NodeWrap NodeWrap))
parameters))
:| []))) =
forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT forall a b. (a -> b) -> a -> b
$ \s :: (Map
Text
(Validation (NonEmpty (Error l)) (DeclarationRHS l Placed Placed)),
ResolutionState)
s@(Map
Text
(Validation (NonEmpty (Error l)) (DeclarationRHS l Placed Placed))
scope, ResolutionState
state)->
let innerScope :: Map
Text
(Validation (NonEmpty (Error l)) (DeclarationRHS l Placed Placed))
innerScope = Map
Text
(Validation (NonEmpty (Error l)) (DeclarationRHS l Placed Placed))
parameterScope forall k a. Ord k => Map k a -> Map k a -> Map k a
`Map.union` forall e (f' :: * -> *).
Map Text (Validation e (DeclarationRHS l f' Placed))
receiverBinding forall k a. Ord k => Map k a -> Map k a -> Map k a
`Map.union` Map
Text
(Validation (NonEmpty (Error l)) (DeclarationRHS l Placed Placed))
scope
receiverBinding :: Map Ident (Validation e (DeclarationRHS l f' Placed))
receiverBinding :: forall e (f' :: * -> *).
Map Text (Validation e (DeclarationRHS l f' Placed))
receiverBinding = forall k a. k -> a -> Map k a
Map.singleton Text
receiverName (forall e a. a -> Validation e a
Success forall a b. (a -> b) -> a -> b
$ forall l (f' :: * -> *) (f :: * -> *).
f (Type l l f' f') -> DeclarationRHS l f' f
DeclaredVariable forall a b. (a -> b) -> a -> b
$ (,) (Int
start, ParsedLexemes
ws, Int
end)
forall a b. (a -> b) -> a -> b
$ forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
QualIdent l' -> Type l l' f' f
Abstract.typeReference
forall a b. (a -> b) -> a -> b
$ forall l. Wirthy l => Text -> QualIdent l
Abstract.nonQualIdent Text
receiverType)
parameterScope :: Map
Text
(Validation (NonEmpty (Error l)) (DeclarationRHS l Placed Placed))
parameterScope = case Maybe
(Compose
((,) (Int, Int))
(Compose Ambiguous ((,) ParsedLexemes))
(FormalParameters l l NodeWrap NodeWrap))
parameters
of Maybe
(Compose
((,) (Int, Int))
(Compose Ambiguous ((,) ParsedLexemes))
(FormalParameters l l NodeWrap NodeWrap))
Nothing -> forall a. Monoid a => a
mempty
Just (Compose ((Int, Int)
_, Compose (Ambiguous ((ParsedLexemes
ws, FormalParameters l l NodeWrap NodeWrap
fp) :| [])))) | [Compose
((,) (Int, Int))
(Compose Ambiguous ((,) ParsedLexemes))
(FPSection l l NodeWrap NodeWrap)]
sections <- forall l (f' :: * -> *) (f :: * -> *).
CoFormalParameters l =>
FormalParameters l l f' f -> [f (FPSection l l f' f')]
getFPSections FormalParameters l l NodeWrap NodeWrap
fp
-> forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Compose
((,) (Int, Int))
(Compose Ambiguous ((,) ParsedLexemes))
(FPSection l l NodeWrap NodeWrap)
-> [(Text,
Validation (NonEmpty (Error l)) (DeclarationRHS l Placed Placed))]
binding [Compose
((,) (Int, Int))
(Compose Ambiguous ((,) ParsedLexemes))
(FPSection l l NodeWrap NodeWrap)]
sections)
binding :: Compose
((,) (Int, Int))
(Compose Ambiguous ((,) ParsedLexemes))
(FPSection l l NodeWrap NodeWrap)
-> [(Text,
Validation (NonEmpty (Error l)) (DeclarationRHS l Placed Placed))]
binding (Compose ((Int, Int)
_, Compose (Ambiguous ((ParsedLexemes
_, FPSection l l NodeWrap NodeWrap
section) :| [])))) = forall l (f' :: * -> *) (f :: * -> *) r.
CoFormalParameters l =>
FPSection l l f' f
-> (Bool -> [Text] -> f (Type l l f' f') -> r) -> r
evalFPSection FPSection l l NodeWrap NodeWrap
section forall a b. (a -> b) -> a -> b
$ \ Bool
_ [Text]
names NodeWrap (Type l l NodeWrap NodeWrap)
types->
[(Text
v, forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (forall t (g :: (* -> *) -> (* -> *) -> *) (m :: * -> *)
(f :: * -> *).
(Traversable t g, Codomain t ~ Compose m f) =>
t -> g (Domain t) (Domain t) -> m (g f f)
Deep.traverse Resolution l
res forall a b. (a -> b) -> a -> b
$ forall l (f' :: * -> *) (f :: * -> *).
f (Type l l f' f') -> DeclarationRHS l f' f
DeclaredVariable NodeWrap (Type l l NodeWrap NodeWrap)
types) (Map
Text
(Validation (NonEmpty (Error l)) (DeclarationRHS l Placed Placed)),
ResolutionState)
s) | Text
v <- [Text]
names]
in forall e a. a -> Validation e a
Success (((Int
start, ParsedLexemes
ws, Int
end), ProcedureHeading l l NodeWrap NodeWrap
proc), (Map
Text
(Validation (NonEmpty (Error l)) (DeclarationRHS l Placed Placed))
innerScope, ResolutionState
state))
instance {-# overlaps #-}
(BindableDeclaration l,
Full.Traversable (Resolution l) (Abstract.Type l l),
Full.Traversable (Resolution l) (Abstract.FormalParameters l l),
Full.Traversable (Resolution l) (Abstract.ConstExpression l l),
Deep.Traversable (Resolution l) (DeclarationRHS l),
Deep.Traversable (Resolution l) (Abstract.Type l l),
Deep.Traversable (Resolution l) (Abstract.FormalParameters l l),
Deep.Traversable (Resolution l) (Abstract.ConstExpression l l)) =>
Resolution l `Transformation.At` Block l l NodeWrap NodeWrap where
Resolution l
res $ :: Resolution l
-> Domain (Resolution l) (Block l l NodeWrap NodeWrap)
-> Codomain (Resolution l) (Block l l NodeWrap NodeWrap)
$ Compose ((Int
start, Int
end), Compose (Ambiguous ((ParsedLexemes
ws, body :: Block l l NodeWrap NodeWrap
body@(Block (ZipList [Compose
((,) (Int, Int))
(Compose Ambiguous ((,) ParsedLexemes))
(Declaration l l NodeWrap NodeWrap)]
declarations) Maybe
(Compose
((,) (Int, Int))
(Compose Ambiguous ((,) ParsedLexemes))
(StatementSequence l l NodeWrap NodeWrap))
_statements)) :| []))) =
forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT forall a b. (a -> b) -> a -> b
$ \(Scope l
scope, ResolutionState
state)-> forall e a. a -> Validation e a
Success (((Int
start, ParsedLexemes
ws, Int
end), Block l l NodeWrap NodeWrap
body),
(forall l.
(BindableDeclaration l,
Traversable (Resolution l) (DeclarationRHS l),
Traversable (Resolution l) (Type l l),
Traversable (Resolution l) (FormalParameters l l),
Traversable (Resolution l) (ConstExpression l l)) =>
Resolution l
-> Text
-> [NodeWrap (Declaration l l NodeWrap NodeWrap)]
-> Scope l
-> Scope l
localScope Resolution l
res Text
"" [Compose
((,) (Int, Int))
(Compose Ambiguous ((,) ParsedLexemes))
(Declaration l l NodeWrap NodeWrap)]
declarations Scope l
scope, ResolutionState
state))
Resolution l
_ $ Domain (Resolution l) (Block l l NodeWrap NodeWrap)
_ = forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall e a. e -> Validation e a
Failure forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure forall l. Error l
AmbiguousParses)
instance {-# overlaps #-}
(Deep.Traversable (Resolution l) (Abstract.Designator l l),
Resolution l `Transformation.At` Abstract.Designator l l NodeWrap NodeWrap) =>
Resolution l `Transformation.At` Statement l l NodeWrap NodeWrap where
Resolution l
res $ :: Resolution l
-> Domain (Resolution l) (Statement l l NodeWrap NodeWrap)
-> Codomain (Resolution l) (Statement l l NodeWrap NodeWrap)
$ Domain (Resolution l) (Statement l l NodeWrap NodeWrap)
statements = forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT forall a b. (a -> b) -> a -> b
$ \s :: (Scope l, ResolutionState)
s@(Scope l
scope, ResolutionState
_state)->
let resolveStatement :: Statement l l NodeWrap NodeWrap
-> Validation (NonEmpty (Error l)) (Statement l l NodeWrap NodeWrap, ResolutionState)
resolveStatement :: Statement l l NodeWrap NodeWrap
-> Validation
(NonEmpty (Error l))
(Statement l l NodeWrap NodeWrap, ResolutionState)
resolveStatement p :: Statement l l NodeWrap NodeWrap
p@(ProcedureCall NodeWrap (Designator l l NodeWrap NodeWrap)
procedures Maybe (ZipList (NodeWrap (Expression l l NodeWrap NodeWrap)))
_parameters) =
case forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (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
$ Resolution l
res forall t x. At t x => t -> Domain t x -> Codomain t x
Transformation.$ NodeWrap (Designator l l NodeWrap NodeWrap)
procedures) (Scope l, ResolutionState)
s
of Failure NonEmpty (Error l)
errors -> forall e a. e -> Validation e a
Failure NonEmpty (Error l)
errors
Success{} -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Statement l l NodeWrap NodeWrap
p, ResolutionState
StatementState)
resolveStatement Statement l l NodeWrap NodeWrap
stat = forall (f :: * -> *) a. Applicative f => a -> f a
pure (Statement l l NodeWrap NodeWrap
stat, ResolutionState
StatementState)
in (\((Int, ParsedLexemes, Int)
pos, (Statement l l NodeWrap NodeWrap
r, ResolutionState
s'))-> (((Int, ParsedLexemes, Int)
pos, Statement l l NodeWrap NodeWrap
r), (Scope l
scope, ResolutionState
s')))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall l a.
(NonEmpty (Error l) -> Error l)
-> ([a] -> Error l)
-> NodeWrap (Validation (NonEmpty (Error l)) a)
-> Validation (NonEmpty (Error l)) (Placed a)
unique forall l. NonEmpty (Error l) -> Error l
InvalidStatement (forall l. [Statement l l NodeWrap NodeWrap] -> Error l
AmbiguousStatement forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>)) (Statement l l NodeWrap NodeWrap
-> Validation
(NonEmpty (Error l))
(Statement l l NodeWrap NodeWrap, ResolutionState)
resolveStatement forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Domain (Resolution l) (Statement l l NodeWrap NodeWrap)
statements)
traverseResolveDefault :: Resolution l -> NodeWrap (g (f :: * -> *) f) -> Compose (Resolved l) Placed (g f f)
traverseResolveDefault :: forall l (g :: (* -> *) -> (* -> *) -> *) (f :: * -> *).
Resolution l
-> NodeWrap (g f f) -> Compose (Resolved l) Placed (g f f)
traverseResolveDefault Resolution{} (Compose ((Int
start, Int
end), Compose (Ambiguous ((ParsedLexemes
ws, g f f
x) :| [])))) =
forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT forall a b. (a -> b) -> a -> b
$ \(Scope l, ResolutionState)
s-> forall e a. a -> Validation e a
Success (((Int
start, ParsedLexemes
ws, Int
end), g f f
x), (Scope l, ResolutionState)
s))
traverseResolveDefault Resolution{} Compose
((,) (Int, Int)) (Compose Ambiguous ((,) ParsedLexemes)) (g f f)
_ = forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (forall s (m :: * -> *) a. (s -> m (a, s)) -> StateT s m a
StateT forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall e a. e -> Validation e a
Failure forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure forall l. Error l
AmbiguousParses)
class Resolvable l where
resolveDesignator :: Resolution l -> Scope l -> ResolutionState -> (Designator l l NodeWrap NodeWrap)
-> Validation (NonEmpty (Error l)) (Designator l l NodeWrap NodeWrap)
resolveRecord :: Resolution l -> Scope l -> ResolutionState -> (Designator l l NodeWrap NodeWrap)
-> Validation (NonEmpty (Error l)) (Designator l l NodeWrap NodeWrap)
instance Resolvable Language where
resolveDesignator :: Resolution Language
-> Scope Language
-> ResolutionState
-> Designator Language Language NodeWrap NodeWrap
-> Validation
(NonEmpty (Error Language))
(Designator Language Language NodeWrap NodeWrap)
resolveDesignator Resolution Language
res Scope Language
scope ResolutionState
state (Variable QualIdent Language
q) =
case forall l.
(Nameable l, Oberon l) =>
Resolution l
-> Scope l
-> QualIdent l
-> Validation (NonEmpty (Error l)) (DeclarationRHS l Placed Placed)
resolveName Resolution Language
res Scope Language
scope QualIdent Language
q
of Failure NonEmpty (Error Language)
err -> forall e a. e -> Validation e a
Failure NonEmpty (Error Language)
err
Success DeclaredType{} | ResolutionState
state forall a. Eq a => a -> a -> Bool
/= ResolutionState
ExpressionOrTypeState -> forall e a. e -> Validation e a
Failure (forall l. QualIdent l -> Error l
NotAValue QualIdent Language
q forall a. a -> [a] -> NonEmpty a
:| [])
Success DeclarationRHS Language Placed Placed
_ -> forall e a. a -> Validation e a
Success (forall λ l (f' :: * -> *) (f :: * -> *).
QualIdent l -> Designator λ l f' f
Variable QualIdent Language
q)
resolveDesignator Resolution Language
res Scope Language
scope ResolutionState
state d :: Designator Language Language NodeWrap NodeWrap
d@(Field NodeWrap (Designator Language Language NodeWrap NodeWrap)
records Text
field) =
case forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (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
$ Resolution Language
res forall t x. At t x => t -> Domain t x -> Codomain t x
Transformation.$ NodeWrap (Designator Language Language NodeWrap NodeWrap)
records) (Scope Language
scope, ResolutionState
state)
of Failure NonEmpty (Error Language)
errors -> forall e a. e -> Validation e a
Failure NonEmpty (Error Language)
errors
Success{} -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Designator Language Language NodeWrap NodeWrap
d
resolveDesignator Resolution Language
res Scope Language
scope ResolutionState
state (TypeGuard NodeWrap (Designator Language Language NodeWrap NodeWrap)
records QualIdent Language
subtypes) =
case forall l a.
(NonEmpty (Error l) -> Error l)
-> ([a] -> Error l)
-> NodeWrap (Validation (NonEmpty (Error l)) a)
-> Validation (NonEmpty (Error l)) (Placed a)
unique forall l. NonEmpty (Error l) -> Error l
InvalidRecord forall l. [Designator l l NodeWrap NodeWrap] -> Error l
AmbiguousRecord (forall l.
Resolvable l =>
Resolution l
-> Scope l
-> ResolutionState
-> Designator l l NodeWrap NodeWrap
-> Validation
(NonEmpty (Error l)) (Designator l l NodeWrap NodeWrap)
resolveRecord Resolution Language
res Scope Language
scope ResolutionState
state forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NodeWrap (Designator Language Language NodeWrap NodeWrap)
records)
of Failure NonEmpty (Error Language)
errors -> forall e a. e -> Validation e a
Failure NonEmpty (Error Language)
errors
Success{} -> forall λ l (f' :: * -> *) (f :: * -> *).
f (Designator l l f' f') -> QualIdent l -> Designator λ l f' f
TypeGuard NodeWrap (Designator Language Language NodeWrap NodeWrap)
records forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {l}.
(Nameable l, Oberon l) =>
Resolution l
-> Scope l
-> QualIdent l
-> Validation (NonEmpty (Error l)) (QualIdent l)
resolveTypeName Resolution Language
res Scope Language
scope QualIdent Language
subtypes
resolveDesignator Resolution Language
res Scope Language
scope ResolutionState
state d :: Designator Language Language NodeWrap NodeWrap
d@(Dereference NodeWrap (Designator Language Language NodeWrap NodeWrap)
pointers) =
case forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (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
$ Resolution Language
res forall t x. At t x => t -> Domain t x -> Codomain t x
Transformation.$ NodeWrap (Designator Language Language NodeWrap NodeWrap)
pointers) (Scope Language
scope, ResolutionState
state)
of Failure NonEmpty (Error Language)
errors -> forall e a. e -> Validation e a
Failure NonEmpty (Error Language)
errors
Success{} -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Designator Language Language NodeWrap NodeWrap
d
resolveDesignator Resolution Language
_ Scope Language
_ ResolutionState
_ Designator Language Language NodeWrap NodeWrap
d = forall (f :: * -> *) a. Applicative f => a -> f a
pure Designator Language Language NodeWrap NodeWrap
d
resolveRecord :: Resolution Language
-> Scope Language
-> ResolutionState
-> Designator Language Language NodeWrap NodeWrap
-> Validation
(NonEmpty (Error Language))
(Designator Language Language NodeWrap NodeWrap)
resolveRecord Resolution Language
res Scope Language
scope ResolutionState
state d :: Designator Language Language NodeWrap NodeWrap
d@(Variable QualIdent Language
q) =
case forall l.
(Nameable l, Oberon l) =>
Resolution l
-> Scope l
-> QualIdent l
-> Validation (NonEmpty (Error l)) (DeclarationRHS l Placed Placed)
resolveName Resolution Language
res Scope Language
scope QualIdent Language
q
of Failure NonEmpty (Error Language)
err -> forall e a. e -> Validation e a
Failure NonEmpty (Error Language)
err
Success DeclaredType{} -> forall e a. e -> Validation e a
Failure (forall l. QualIdent l -> Error l
NotAValue QualIdent Language
q forall a. a -> [a] -> NonEmpty a
:| [])
Success DeclaredProcedure{} -> forall e a. e -> Validation e a
Failure (forall l. QualIdent l -> Error l
NotARecord QualIdent Language
q forall a. a -> [a] -> NonEmpty a
:| [])
Success DeclaredVariable{} -> forall l.
Resolvable l =>
Resolution l
-> Scope l
-> ResolutionState
-> Designator l l NodeWrap NodeWrap
-> Validation
(NonEmpty (Error l)) (Designator l l NodeWrap NodeWrap)
resolveDesignator Resolution Language
res Scope Language
scope ResolutionState
state Designator Language Language NodeWrap NodeWrap
d
resolveRecord Resolution Language
res Scope Language
scope ResolutionState
state Designator Language Language NodeWrap NodeWrap
d = forall l.
Resolvable l =>
Resolution l
-> Scope l
-> ResolutionState
-> Designator l l NodeWrap NodeWrap
-> Validation
(NonEmpty (Error l)) (Designator l l NodeWrap NodeWrap)
resolveDesignator Resolution Language
res Scope Language
scope ResolutionState
state Designator Language Language NodeWrap NodeWrap
d
resolveTypeName :: Resolution l
-> Scope l
-> QualIdent l
-> Validation (NonEmpty (Error l)) (QualIdent l)
resolveTypeName Resolution l
res Scope l
scope QualIdent l
q =
case forall l.
(Nameable l, Oberon l) =>
Resolution l
-> Scope l
-> QualIdent l
-> Validation (NonEmpty (Error l)) (DeclarationRHS l Placed Placed)
resolveName Resolution l
res Scope l
scope QualIdent l
q
of Failure NonEmpty (Error l)
err -> forall e a. e -> Validation e a
Failure NonEmpty (Error l)
err
Success DeclaredType{} -> forall e a. a -> Validation e a
Success QualIdent l
q
Success DeclarationRHS l Placed Placed
_ -> forall e a. e -> Validation e a
Failure (forall l. QualIdent l -> Error l
NotAType QualIdent l
q forall a. a -> [a] -> NonEmpty a
:| [])
resolveName :: (Abstract.Nameable l, Abstract.Oberon l)
=> Resolution l -> Scope l -> Abstract.QualIdent l
-> Validation (NonEmpty (Error l)) (DeclarationRHS l Placed Placed)
resolveName :: forall l.
(Nameable l, Oberon l) =>
Resolution l
-> Scope l
-> QualIdent l
-> Validation (NonEmpty (Error l)) (DeclarationRHS l Placed Placed)
resolveName Resolution l
res Scope l
scope QualIdent l
q
| Just (Text
moduleName, Text
name) <- forall l. Oberon l => QualIdent l -> Maybe (Text, Text)
Abstract.getQualIdentNames QualIdent l
q =
case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
moduleName (forall l. Resolution l -> Map Text (Scope l)
_modules Resolution l
res)
of Maybe (Scope l)
Nothing -> forall e a. e -> Validation e a
Failure (forall l. QualIdent l -> Error l
UnknownModule QualIdent l
q forall a. a -> [a] -> NonEmpty a
:| [])
Just Scope l
exports -> case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
name Scope l
exports
of Just Validation (NonEmpty (Error l)) (DeclarationRHS l Placed Placed)
rhs -> Validation (NonEmpty (Error l)) (DeclarationRHS l Placed Placed)
rhs
Maybe
(Validation (NonEmpty (Error l)) (DeclarationRHS l Placed Placed))
Nothing -> forall e a. e -> Validation e a
Failure (forall l. QualIdent l -> Error l
UnknownImport QualIdent l
q forall a. a -> [a] -> NonEmpty a
:| [])
| Just Text
name <- forall l. Nameable l => QualIdent l -> Maybe Text
Abstract.getNonQualIdentName QualIdent l
q =
case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
name Scope l
scope
of Just (Success DeclarationRHS l Placed Placed
rhs) -> forall e a. a -> Validation e a
Success DeclarationRHS l Placed Placed
rhs
Maybe
(Validation (NonEmpty (Error l)) (DeclarationRHS l Placed Placed))
_ -> forall e a. e -> Validation e a
Failure (forall l. Text -> Error l
UnknownLocal Text
name forall a. a -> [a] -> NonEmpty a
:| [])
resolveModules :: forall l. (BindableDeclaration l, CoFormalParameters l, Abstract.Wirthy l,
Deep.Traversable (Resolution l) (Abstract.Declaration l l),
Deep.Traversable (Resolution l) (DeclarationRHS l),
Deep.Traversable (Resolution l) (Abstract.Type l l),
Deep.Traversable (Resolution l) (Abstract.ProcedureHeading l l),
Deep.Traversable (Resolution l) (Abstract.FormalParameters l l),
Deep.Traversable (Resolution l) (Abstract.Expression l l),
Deep.Traversable (Resolution l) (Abstract.Block l l),
Deep.Traversable (Resolution l) (Abstract.StatementSequence l l),
Full.Traversable (Resolution l) (Module l l),
Full.Traversable (Resolution l) (Abstract.Declaration l l),
Full.Traversable (Resolution l) (Abstract.Type l l),
Full.Traversable (Resolution l) (Abstract.ProcedureHeading l l),
Full.Traversable (Resolution l) (Abstract.FormalParameters l l),
Full.Traversable (Resolution l) (Abstract.Expression l l),
Full.Traversable (Resolution l) (Abstract.Block l l),
Full.Traversable (Resolution l) (Abstract.StatementSequence l l),
Resolution l `Transformation.At` Abstract.Block l l NodeWrap NodeWrap) =>
Predefined l -> Map Ident (NodeWrap (Module l l NodeWrap NodeWrap))
-> Validation (NonEmpty (Ident, NonEmpty (Error l))) (Map Ident (Placed (Module l l Placed Placed)))
resolveModules :: forall l.
(BindableDeclaration l, CoFormalParameters l, Wirthy l,
Traversable (Resolution l) (Declaration l l),
Traversable (Resolution l) (DeclarationRHS l),
Traversable (Resolution l) (Type l l),
Traversable (Resolution l) (ProcedureHeading l l),
Traversable (Resolution l) (FormalParameters l l),
Traversable (Resolution l) (Expression l l),
Traversable (Resolution l) (Block l l),
Traversable (Resolution l) (StatementSequence l l),
Traversable (Resolution l) (Module l l),
Traversable (Resolution l) (Declaration l l),
Traversable (Resolution l) (Type l l),
Traversable (Resolution l) (ProcedureHeading l l),
Traversable (Resolution l) (FormalParameters l l),
Traversable (Resolution l) (Expression l l),
Traversable (Resolution l) (Block l l),
Traversable (Resolution l) (StatementSequence l l),
At (Resolution l) (Block l l NodeWrap NodeWrap)) =>
Predefined l
-> Map Text (NodeWrap (Module l l NodeWrap NodeWrap))
-> Validation
(NonEmpty (Text, NonEmpty (Error l)))
(Map Text (Placed (Module l l Placed Placed)))
resolveModules Predefined l
predefinedScope Map Text (NodeWrap (Module l l NodeWrap NodeWrap))
modules = forall (t :: * -> *) k a b.
Applicative t =>
(k -> a -> t b) -> Map k a -> t (Map k b)
traverseWithKey forall {a} {b} {a}.
a -> Validation b a -> Validation (NonEmpty (a, b)) a
extractErrors Map
Text
(Validation
(NonEmpty (Error l)) (Placed (Module l l Placed Placed)))
modules'
where modules' :: Map
Text
(Validation
(NonEmpty (Error l)) (Placed (Module l l Placed Placed)))
modules' = 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 NodeWrap NodeWrap)) =>
Scope l
-> Map
Text
(Validation
(NonEmpty (Error l)) (Placed (Module l l Placed Placed)))
-> NodeWrap (Module l l NodeWrap NodeWrap)
-> Validation
(NonEmpty (Error l)) (Placed (Module l l Placed Placed))
resolveModule Predefined l
predefinedScope Map
Text
(Validation
(NonEmpty (Error l)) (Placed (Module l l Placed Placed)))
modules' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Text (NodeWrap (Module l l NodeWrap NodeWrap))
modules
extractErrors :: a -> Validation b a -> Validation (NonEmpty (a, b)) a
extractErrors a
moduleKey (Failure b
e) = forall e a. e -> Validation e a
Failure ((a
moduleKey, b
e) forall a. a -> [a] -> NonEmpty a
:| [])
extractErrors a
_ (Success a
mod) = forall e a. a -> Validation e a
Success a
mod
resolveModule :: forall l. (BindableDeclaration l, CoFormalParameters l,
Full.Traversable (Resolution l) (Module l l),
Full.Traversable (Resolution l) (Abstract.Block l l),
Full.Traversable (Resolution l) (Abstract.Declaration l l),
Full.Traversable (Resolution l) (Abstract.Type l l),
Full.Traversable (Resolution l) (Abstract.FormalParameters l l),
Full.Traversable (Resolution l) (Abstract.ConstExpression l l),
Full.Traversable (Resolution l) (Abstract.StatementSequence l l),
Deep.Traversable (Resolution l) (Declaration l l),
Deep.Traversable (Resolution l) (DeclarationRHS l),
Deep.Traversable (Resolution l) (Abstract.Declaration l l),
Deep.Traversable (Resolution l) (Abstract.StatementSequence l l),
Deep.Traversable (Resolution l) (Abstract.Type l l),
Deep.Traversable (Resolution l) (Abstract.FormalParameters l l),
Deep.Traversable (Resolution l) (Abstract.ConstExpression l l),
Resolution l `Transformation.At` Abstract.Block l l NodeWrap NodeWrap) =>
Scope l -> Map Ident (Validation (NonEmpty (Error l)) (Placed (Module l l Placed Placed)))
-> NodeWrap (Module l l NodeWrap NodeWrap)
-> Validation (NonEmpty (Error l)) (Placed (Module l l Placed Placed))
resolveModule :: 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 NodeWrap NodeWrap)) =>
Scope l
-> Map
Text
(Validation
(NonEmpty (Error l)) (Placed (Module l l Placed Placed)))
-> NodeWrap (Module l l NodeWrap NodeWrap)
-> Validation
(NonEmpty (Error l)) (Placed (Module l l Placed Placed))
resolveModule Scope l
predefined Map
Text
(Validation
(NonEmpty (Error l)) (Placed (Module l l Placed Placed)))
modules m :: NodeWrap (Module l l NodeWrap NodeWrap)
m@(Compose ((Int, Int)
pos, Compose (Ambiguous ((ParsedLexemes
ls, Module Text
moduleName [Import l]
imports NodeWrap (Block l l NodeWrap NodeWrap)
body) :| [])))) =
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (forall t (g :: (* -> *) -> (* -> *) -> *) (m :: * -> *)
(f :: * -> *).
(Traversable t g, Codomain t ~ Compose m f) =>
t -> Domain t (g (Domain t) (Domain t)) -> m (f (g f f))
Full.traverse Resolution l
res NodeWrap (Module l l NodeWrap NodeWrap)
m) (Scope l
moduleGlobalScope, ResolutionState
ModuleState)
where res :: Resolution l
res = forall l. Map Text (Scope l) -> Resolution l
Resolution Map Text (Scope l)
moduleExports
importedModules :: Map
Text
(Validation
(NonEmpty (Error l)) (Placed (Module l l Placed Placed)))
importedModules = forall k a. Ord k => k -> Map k a -> Map k a
Map.delete forall a. Monoid a => a
mempty (forall k2 a k1.
Ord k2 =>
(a -> a -> a) -> (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeysWith forall {p} {p} {l} {a}. p -> p -> Validation (NonEmpty (Error l)) a
clashingRenames Text -> Text
importedAs Map
Text
(Validation
(NonEmpty (Error l)) (Placed (Module l l Placed Placed)))
modules)
where importedAs :: Text -> Text
importedAs Text
moduleName = case forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find ((forall a. Eq a => a -> a -> Bool
== Text
moduleName) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [Import l]
imports
of Just (Maybe Text
Nothing, Text
moduleKey) -> Text
moduleKey
Just (Just Text
innerKey, Text
_) -> Text
innerKey
Maybe (Import l)
Nothing -> forall a. Monoid a => a
mempty
clashingRenames :: p -> p -> Validation (NonEmpty (Error l)) a
clashingRenames p
_ p
_ = forall e a. e -> Validation e a
Failure (forall l. Error l
ClashingImports forall a. a -> [a] -> NonEmpty a
:| [])
resolveDeclaration :: NodeWrap (Declaration l l NodeWrap NodeWrap) -> Resolved l (Declaration l l Placed Placed)
resolveDeclaration :: NodeWrap (Declaration l l NodeWrap NodeWrap)
-> Resolved l (Declaration l l Placed Placed)
resolveDeclaration NodeWrap (Declaration l l NodeWrap NodeWrap)
d = forall a b. (a, b) -> b
snd 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 t (g :: (* -> *) -> (* -> *) -> *) (m :: * -> *)
(f :: * -> *).
(Traversable t g, Codomain t ~ Compose m f) =>
t -> g (Domain t) (Domain t) -> m (g f f)
Deep.traverse Resolution l
res) NodeWrap (Declaration l l NodeWrap NodeWrap)
d forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {k1} {k2} (f :: k1 -> *) (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Resolution l
res forall t x. At t x => t -> Domain t x -> Codomain t x
Transformation.$))
moduleExports :: Map Text (Scope l)
moduleExports = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall l.
(BindableDeclaration l, CoFormalParameters l) =>
Module l l Placed Placed -> Scope l
exportsOfModule 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
<$> Map
Text
(Validation
(NonEmpty (Error l)) (Placed (Module l l Placed Placed)))
importedModules
Success ((Int, ParsedLexemes, Int)
_, Block l l NodeWrap NodeWrap
body') = forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (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
$ Resolution l
res forall t x. At t x => t -> Domain t x -> Codomain t x
Transformation.$ NodeWrap (Block l l NodeWrap NodeWrap)
body) (Scope l
predefined, ResolutionState
ModuleState)
moduleGlobalScope :: Scope l
moduleGlobalScope = forall l.
(BindableDeclaration l,
Traversable (Resolution l) (DeclarationRHS l),
Traversable (Resolution l) (Type l l),
Traversable (Resolution l) (FormalParameters l l),
Traversable (Resolution l) (ConstExpression l l)) =>
Resolution l
-> Text
-> [NodeWrap (Declaration l l NodeWrap NodeWrap)]
-> Scope l
-> Scope l
localScope Resolution l
res Text
moduleName (forall l (f' :: * -> *) (f :: * -> *).
CoFormalParameters l =>
Block l l f' f -> [f (Declaration l l f' f')]
getLocalDeclarations Block l l NodeWrap NodeWrap
body') Scope l
predefined
localScope :: forall l. (BindableDeclaration l,
Deep.Traversable (Resolution l) (DeclarationRHS l),
Full.Traversable (Resolution l) (Abstract.Type l l),
Full.Traversable (Resolution l) (Abstract.FormalParameters l l),
Full.Traversable (Resolution l) (Abstract.ConstExpression l l)) =>
Resolution l -> Ident -> [NodeWrap (Abstract.Declaration l l NodeWrap NodeWrap)] -> Scope l -> Scope l
localScope :: forall l.
(BindableDeclaration l,
Traversable (Resolution l) (DeclarationRHS l),
Traversable (Resolution l) (Type l l),
Traversable (Resolution l) (FormalParameters l l),
Traversable (Resolution l) (ConstExpression l l)) =>
Resolution l
-> Text
-> [NodeWrap (Declaration l l NodeWrap NodeWrap)]
-> Scope l
-> Scope l
localScope Resolution l
res Text
qual [NodeWrap (Declaration l l NodeWrap NodeWrap)]
declarations Scope l
outerScope = Scope l
innerScope
where innerScope :: Scope l
innerScope = forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union (forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map
Text
(AccessMode,
Validation (NonEmpty (Error l)) (DeclarationRHS l Placed Placed))
scopeAdditions) Scope l
outerScope
scopeAdditions :: Map
Text
(AccessMode,
Validation (NonEmpty (Error l)) (DeclarationRHS l Placed Placed))
scopeAdditions = (Resolution l
-> Scope l
-> DeclarationRHS l NodeWrap NodeWrap
-> Validation (NonEmpty (Error l)) (DeclarationRHS l Placed Placed)
resolveBinding Resolution l
res Scope l
innerScope forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall l (f :: * -> *).
(BindableDeclaration l, Foldable f) =>
Text
-> Declaration l l f f
-> [(Text, (AccessMode, DeclarationRHS l f f))]
declarationBinding Text
qual forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a} {a} {a}.
Compose ((,) a) (Compose Ambiguous ((,) a)) a -> a
unamb) [NodeWrap (Declaration l l NodeWrap NodeWrap)]
declarations)
unamb :: Compose ((,) a) (Compose Ambiguous ((,) a)) a -> a
unamb (Compose (a
offset, Compose (Ambiguous ((a
_, a
x) :| [])))) = a
x
resolveBinding :: Resolution l -> Scope l -> DeclarationRHS l NodeWrap NodeWrap
-> Validation (NonEmpty (Error l)) (DeclarationRHS l Placed Placed)
resolveBinding :: Resolution l
-> Scope l
-> DeclarationRHS l NodeWrap NodeWrap
-> Validation (NonEmpty (Error l)) (DeclarationRHS l Placed Placed)
resolveBinding Resolution l
res Scope l
scope DeclarationRHS l NodeWrap NodeWrap
dr = forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (forall t (g :: (* -> *) -> (* -> *) -> *) (m :: * -> *)
(f :: * -> *).
(Traversable t g, Codomain t ~ Compose m f) =>
t -> g (Domain t) (Domain t) -> m (g f f)
Deep.traverse Resolution l
res DeclarationRHS l NodeWrap NodeWrap
dr) (Scope l
scope, ResolutionState
DeclarationState)
class BindableDeclaration l where
declarationBinding :: Foldable f => Ident -> Abstract.Declaration l l f f -> [(Ident, (AccessMode, DeclarationRHS l f f))]
instance BindableDeclaration Language where
declarationBinding :: forall (f :: * -> *).
Foldable f =>
Text
-> Declaration Language Language f f
-> [(Text, (AccessMode, DeclarationRHS Language f f))]
declarationBinding Text
_ (ConstantDeclaration (IdentDef Text
name AccessMode
export) f (ConstExpression Language Language f f)
expr) =
[(Text
name, (AccessMode
export, forall l (f' :: * -> *) (f :: * -> *).
f (ConstExpression l l f' f') -> DeclarationRHS l f' f
DeclaredConstant f (ConstExpression Language Language f f)
expr))]
declarationBinding Text
_ (TypeDeclaration (IdentDef Text
name AccessMode
export) f (Type Language Language f f)
typeDef) =
[(Text
name, (AccessMode
export, forall l (f' :: * -> *) (f :: * -> *).
f (Type l l f' f') -> DeclarationRHS l f' f
DeclaredType f (Type Language Language f f)
typeDef))]
declarationBinding Text
_ (VariableDeclaration IdentList Language
names f (Type Language Language f f)
typeDef) =
[(Text
name, (AccessMode
export, forall l (f' :: * -> *) (f :: * -> *).
f (Type l l f' f') -> DeclarationRHS l f' f
DeclaredVariable f (Type Language Language f f)
typeDef)) | (IdentDef Text
name AccessMode
export) <- forall a. NonEmpty a -> [a]
NonEmpty.toList IdentList Language
names]
declarationBinding Text
moduleName (ProcedureDeclaration f (ProcedureHeading Language Language f f)
heading f (Block Language Language f f)
_) = ProcedureHeading Language Language f f
-> [(Text, (AccessMode, DeclarationRHS Language f f))]
procedureHeadBinding (forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 forall a b. a -> b -> a
const f (ProcedureHeading Language Language f f)
heading)
where procedureHeadBinding :: ProcedureHeading Language Language f f
-> [(Text, (AccessMode, DeclarationRHS Language f f))]
procedureHeadBinding (ProcedureHeading Bool
_ (IdentDef Text
name AccessMode
export) Maybe (f (FormalParameters Language Language f f))
parameters) =
[(Text
name, (AccessMode
export, forall l (f' :: * -> *) (f :: * -> *).
Bool
-> Maybe (f (FormalParameters l l f' f')) -> DeclarationRHS l f' f
DeclaredProcedure (Text
moduleName forall a. Eq a => a -> a -> Bool
== Text
"SYSTEM") Maybe (f (FormalParameters Language Language f f))
parameters))]
procedureHeadBinding (TypeBoundHeading Bool
_ Text
_ Text
_ Bool
_ (IdentDef Text
name AccessMode
export) Maybe (f (FormalParameters Language Language f f))
parameters) =
[(Text
name, (AccessMode
export, forall l (f' :: * -> *) (f :: * -> *).
Bool
-> Maybe (f (FormalParameters l l f' f')) -> DeclarationRHS l f' f
DeclaredProcedure (Text
moduleName forall a. Eq a => a -> a -> Bool
== Text
"SYSTEM") Maybe (f (FormalParameters Language Language f f))
parameters))]
declarationBinding Text
_ (ForwardDeclaration (IdentDef Text
name AccessMode
export) Maybe (f (FormalParameters Language Language f f))
parameters) =
[(Text
name, (AccessMode
export, forall l (f' :: * -> *) (f :: * -> *).
Bool
-> Maybe (f (FormalParameters l l f' f')) -> DeclarationRHS l f' f
DeclaredProcedure Bool
False Maybe (f (FormalParameters Language Language f f))
parameters))]
predefined, predefined2 :: Abstract.Oberon l => Predefined l
predefined :: forall l. Oberon l => Predefined l
predefined = forall e a. a -> Validation e a
Success forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
[(Text
"BOOLEAN", forall l (f' :: * -> *) (f :: * -> *).
f (Type l l f' f') -> DeclarationRHS l f' f
DeclaredType (forall {b}. b -> ((Int, ParsedLexemes, Int), b)
wrap forall a b. (a -> b) -> a -> b
$ forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
QualIdent l' -> Type l l' f' f
Abstract.typeReference forall a b. (a -> b) -> a -> b
$ forall l. Wirthy l => Text -> QualIdent l
Abstract.nonQualIdent Text
"BOOLEAN")),
(Text
"CHAR", forall l (f' :: * -> *) (f :: * -> *).
f (Type l l f' f') -> DeclarationRHS l f' f
DeclaredType (forall {b}. b -> ((Int, ParsedLexemes, Int), b)
wrap forall a b. (a -> b) -> a -> b
$ forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
QualIdent l' -> Type l l' f' f
Abstract.typeReference forall a b. (a -> b) -> a -> b
$ forall l. Wirthy l => Text -> QualIdent l
Abstract.nonQualIdent Text
"CHAR")),
(Text
"SHORTINT", forall l (f' :: * -> *) (f :: * -> *).
f (Type l l f' f') -> DeclarationRHS l f' f
DeclaredType (forall {b}. b -> ((Int, ParsedLexemes, Int), b)
wrap forall a b. (a -> b) -> a -> b
$ forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
QualIdent l' -> Type l l' f' f
Abstract.typeReference forall a b. (a -> b) -> a -> b
$ forall l. Wirthy l => Text -> QualIdent l
Abstract.nonQualIdent Text
"SHORTINT")),
(Text
"INTEGER", forall l (f' :: * -> *) (f :: * -> *).
f (Type l l f' f') -> DeclarationRHS l f' f
DeclaredType (forall {b}. b -> ((Int, ParsedLexemes, Int), b)
wrap forall a b. (a -> b) -> a -> b
$ forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
QualIdent l' -> Type l l' f' f
Abstract.typeReference forall a b. (a -> b) -> a -> b
$ forall l. Wirthy l => Text -> QualIdent l
Abstract.nonQualIdent Text
"INTEGER")),
(Text
"LONGINT", forall l (f' :: * -> *) (f :: * -> *).
f (Type l l f' f') -> DeclarationRHS l f' f
DeclaredType (forall {b}. b -> ((Int, ParsedLexemes, Int), b)
wrap forall a b. (a -> b) -> a -> b
$ forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
QualIdent l' -> Type l l' f' f
Abstract.typeReference forall a b. (a -> b) -> a -> b
$ forall l. Wirthy l => Text -> QualIdent l
Abstract.nonQualIdent Text
"LONGINT")),
(Text
"REAL", forall l (f' :: * -> *) (f :: * -> *).
f (Type l l f' f') -> DeclarationRHS l f' f
DeclaredType (forall {b}. b -> ((Int, ParsedLexemes, Int), b)
wrap forall a b. (a -> b) -> a -> b
$ forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
QualIdent l' -> Type l l' f' f
Abstract.typeReference forall a b. (a -> b) -> a -> b
$ forall l. Wirthy l => Text -> QualIdent l
Abstract.nonQualIdent Text
"REAL")),
(Text
"LONGREAL", forall l (f' :: * -> *) (f :: * -> *).
f (Type l l f' f') -> DeclarationRHS l f' f
DeclaredType (forall {b}. b -> ((Int, ParsedLexemes, Int), b)
wrap forall a b. (a -> b) -> a -> b
$ forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
QualIdent l' -> Type l l' f' f
Abstract.typeReference forall a b. (a -> b) -> a -> b
$ forall l. Wirthy l => Text -> QualIdent l
Abstract.nonQualIdent Text
"LONGREAL")),
(Text
"SET", forall l (f' :: * -> *) (f :: * -> *).
f (Type l l f' f') -> DeclarationRHS l f' f
DeclaredType (forall {b}. b -> ((Int, ParsedLexemes, Int), b)
wrap forall a b. (a -> b) -> a -> b
$ forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
QualIdent l' -> Type l l' f' f
Abstract.typeReference forall a b. (a -> b) -> a -> b
$ forall l. Wirthy l => Text -> QualIdent l
Abstract.nonQualIdent Text
"SET")),
(Text
"TRUE", forall l (f' :: * -> *) (f :: * -> *).
f (ConstExpression l l f' f') -> DeclarationRHS l f' f
DeclaredConstant (forall {b}. b -> ((Int, ParsedLexemes, Int), b)
wrap forall a b. (a -> b) -> a -> b
$ forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
f (Designator l' l' f' f') -> Expression l l' f' f
Abstract.read forall a b. (a -> b) -> a -> b
$ forall {b}. b -> ((Int, ParsedLexemes, Int), b)
wrap forall a b. (a -> b) -> a -> b
$ forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
QualIdent l' -> Designator l l' f' f
Abstract.variable forall a b. (a -> b) -> a -> b
$ forall l. Wirthy l => Text -> QualIdent l
Abstract.nonQualIdent Text
"TRUE")),
(Text
"FALSE", forall l (f' :: * -> *) (f :: * -> *).
f (ConstExpression l l f' f') -> DeclarationRHS l f' f
DeclaredConstant (forall {b}. b -> ((Int, ParsedLexemes, Int), b)
wrap forall a b. (a -> b) -> a -> b
$ forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
f (Designator l' l' f' f') -> Expression l l' f' f
Abstract.read forall a b. (a -> b) -> a -> b
$ forall {b}. b -> ((Int, ParsedLexemes, Int), b)
wrap forall a b. (a -> b) -> a -> b
$ forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
QualIdent l' -> Designator l l' f' f
Abstract.variable forall a b. (a -> b) -> a -> b
$ forall l. Wirthy l => Text -> QualIdent l
Abstract.nonQualIdent Text
"FALSE")),
(Text
"ABS", forall l (f' :: * -> *) (f :: * -> *).
Bool
-> Maybe (f (FormalParameters l l f' f')) -> DeclarationRHS l f' f
DeclaredProcedure Bool
False forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {b}. b -> ((Int, ParsedLexemes, Int), b)
wrap forall a b. (a -> b) -> a -> b
$
forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
[f (FPSection l' l' f' f')]
-> Maybe (ReturnType l') -> FormalParameters l l' f' f
Abstract.formalParameters [forall {b}. b -> ((Int, ParsedLexemes, Int), b)
wrap forall a b. (a -> b) -> a -> b
$ forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
Bool -> [Text] -> f (Type l' l' f' f') -> FPSection l l' f' f
Abstract.fpSection Bool
False (forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"n") forall a b. (a -> b) -> a -> b
$ forall {b}. b -> ((Int, ParsedLexemes, Int), b)
wrap
forall a b. (a -> b) -> a -> b
$ forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
QualIdent l' -> Type l l' f' f
Abstract.typeReference forall a b. (a -> b) -> a -> b
$ forall l. Wirthy l => Text -> QualIdent l
Abstract.nonQualIdent Text
"INTEGER"] forall a b. (a -> b) -> a -> b
$
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall l. Wirthy l => Text -> QualIdent l
Abstract.nonQualIdent Text
"INTEGER"),
(Text
"ASH", forall l (f' :: * -> *) (f :: * -> *).
Bool
-> Maybe (f (FormalParameters l l f' f')) -> DeclarationRHS l f' f
DeclaredProcedure Bool
False forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {b}. b -> ((Int, ParsedLexemes, Int), b)
wrap forall a b. (a -> b) -> a -> b
$
forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
[f (FPSection l' l' f' f')]
-> Maybe (ReturnType l') -> FormalParameters l l' f' f
Abstract.formalParameters [forall {b}. b -> ((Int, ParsedLexemes, Int), b)
wrap forall a b. (a -> b) -> a -> b
$ forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
Bool -> [Text] -> f (Type l' l' f' f') -> FPSection l l' f' f
Abstract.fpSection Bool
False (forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"n") forall a b. (a -> b) -> a -> b
$ forall {b}. b -> ((Int, ParsedLexemes, Int), b)
wrap
forall a b. (a -> b) -> a -> b
$ forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
QualIdent l' -> Type l l' f' f
Abstract.typeReference forall a b. (a -> b) -> a -> b
$ forall l. Wirthy l => Text -> QualIdent l
Abstract.nonQualIdent Text
"INTEGER"] forall a b. (a -> b) -> a -> b
$
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall l. Wirthy l => Text -> QualIdent l
Abstract.nonQualIdent Text
"INTEGER"),
(Text
"CAP", forall l (f' :: * -> *) (f :: * -> *).
Bool
-> Maybe (f (FormalParameters l l f' f')) -> DeclarationRHS l f' f
DeclaredProcedure Bool
False forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {b}. b -> ((Int, ParsedLexemes, Int), b)
wrap forall a b. (a -> b) -> a -> b
$
forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
[f (FPSection l' l' f' f')]
-> Maybe (ReturnType l') -> FormalParameters l l' f' f
Abstract.formalParameters [forall {b}. b -> ((Int, ParsedLexemes, Int), b)
wrap forall a b. (a -> b) -> a -> b
$ forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
Bool -> [Text] -> f (Type l' l' f' f') -> FPSection l l' f' f
Abstract.fpSection Bool
False (forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"c") forall a b. (a -> b) -> a -> b
$ forall {b}. b -> ((Int, ParsedLexemes, Int), b)
wrap
forall a b. (a -> b) -> a -> b
$ forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
QualIdent l' -> Type l l' f' f
Abstract.typeReference forall a b. (a -> b) -> a -> b
$ forall l. Wirthy l => Text -> QualIdent l
Abstract.nonQualIdent Text
"CHAR"] forall a b. (a -> b) -> a -> b
$
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall l. Wirthy l => Text -> QualIdent l
Abstract.nonQualIdent Text
"CHAR"),
(Text
"LEN", forall l (f' :: * -> *) (f :: * -> *).
Bool
-> Maybe (f (FormalParameters l l f' f')) -> DeclarationRHS l f' f
DeclaredProcedure Bool
False forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {b}. b -> ((Int, ParsedLexemes, Int), b)
wrap forall a b. (a -> b) -> a -> b
$
forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
[f (FPSection l' l' f' f')]
-> Maybe (ReturnType l') -> FormalParameters l l' f' f
Abstract.formalParameters [forall {b}. b -> ((Int, ParsedLexemes, Int), b)
wrap forall a b. (a -> b) -> a -> b
$ forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
Bool -> [Text] -> f (Type l' l' f' f') -> FPSection l l' f' f
Abstract.fpSection Bool
False (forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"c") forall a b. (a -> b) -> a -> b
$ forall {b}. b -> ((Int, ParsedLexemes, Int), b)
wrap
forall a b. (a -> b) -> a -> b
$ forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
QualIdent l' -> Type l l' f' f
Abstract.typeReference forall a b. (a -> b) -> a -> b
$ forall l. Wirthy l => Text -> QualIdent l
Abstract.nonQualIdent Text
"ARRAY"] forall a b. (a -> b) -> a -> b
$
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall l. Wirthy l => Text -> QualIdent l
Abstract.nonQualIdent Text
"LONGINT"),
(Text
"MAX", forall l (f' :: * -> *) (f :: * -> *).
Bool
-> Maybe (f (FormalParameters l l f' f')) -> DeclarationRHS l f' f
DeclaredProcedure Bool
True forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {b}. b -> ((Int, ParsedLexemes, Int), b)
wrap forall a b. (a -> b) -> a -> b
$
forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
[f (FPSection l' l' f' f')]
-> Maybe (ReturnType l') -> FormalParameters l l' f' f
Abstract.formalParameters [forall {b}. b -> ((Int, ParsedLexemes, Int), b)
wrap forall a b. (a -> b) -> a -> b
$ forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
Bool -> [Text] -> f (Type l' l' f' f') -> FPSection l l' f' f
Abstract.fpSection Bool
False (forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"c") forall a b. (a -> b) -> a -> b
$ forall {b}. b -> ((Int, ParsedLexemes, Int), b)
wrap
forall a b. (a -> b) -> a -> b
$ forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
QualIdent l' -> Type l l' f' f
Abstract.typeReference forall a b. (a -> b) -> a -> b
$ forall l. Wirthy l => Text -> QualIdent l
Abstract.nonQualIdent Text
"SET"] forall a b. (a -> b) -> a -> b
$
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall l. Wirthy l => Text -> QualIdent l
Abstract.nonQualIdent Text
"INTEGER"),
(Text
"MIN", forall l (f' :: * -> *) (f :: * -> *).
Bool
-> Maybe (f (FormalParameters l l f' f')) -> DeclarationRHS l f' f
DeclaredProcedure Bool
True forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {b}. b -> ((Int, ParsedLexemes, Int), b)
wrap forall a b. (a -> b) -> a -> b
$
forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
[f (FPSection l' l' f' f')]
-> Maybe (ReturnType l') -> FormalParameters l l' f' f
Abstract.formalParameters [forall {b}. b -> ((Int, ParsedLexemes, Int), b)
wrap forall a b. (a -> b) -> a -> b
$ forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
Bool -> [Text] -> f (Type l' l' f' f') -> FPSection l l' f' f
Abstract.fpSection Bool
False (forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"c") forall a b. (a -> b) -> a -> b
$ forall {b}. b -> ((Int, ParsedLexemes, Int), b)
wrap
forall a b. (a -> b) -> a -> b
$ forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
QualIdent l' -> Type l l' f' f
Abstract.typeReference forall a b. (a -> b) -> a -> b
$ forall l. Wirthy l => Text -> QualIdent l
Abstract.nonQualIdent Text
"SET"] forall a b. (a -> b) -> a -> b
$
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall l. Wirthy l => Text -> QualIdent l
Abstract.nonQualIdent Text
"INTEGER"),
(Text
"ODD", forall l (f' :: * -> *) (f :: * -> *).
Bool
-> Maybe (f (FormalParameters l l f' f')) -> DeclarationRHS l f' f
DeclaredProcedure Bool
False forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {b}. b -> ((Int, ParsedLexemes, Int), b)
wrap forall a b. (a -> b) -> a -> b
$
forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
[f (FPSection l' l' f' f')]
-> Maybe (ReturnType l') -> FormalParameters l l' f' f
Abstract.formalParameters [forall {b}. b -> ((Int, ParsedLexemes, Int), b)
wrap forall a b. (a -> b) -> a -> b
$ forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
Bool -> [Text] -> f (Type l' l' f' f') -> FPSection l l' f' f
Abstract.fpSection Bool
False (forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"n") forall a b. (a -> b) -> a -> b
$ forall {b}. b -> ((Int, ParsedLexemes, Int), b)
wrap
forall a b. (a -> b) -> a -> b
$ forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
QualIdent l' -> Type l l' f' f
Abstract.typeReference forall a b. (a -> b) -> a -> b
$ forall l. Wirthy l => Text -> QualIdent l
Abstract.nonQualIdent Text
"CHAR"] forall a b. (a -> b) -> a -> b
$
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall l. Wirthy l => Text -> QualIdent l
Abstract.nonQualIdent Text
"BOOLEAN"),
(Text
"SIZE", forall l (f' :: * -> *) (f :: * -> *).
Bool
-> Maybe (f (FormalParameters l l f' f')) -> DeclarationRHS l f' f
DeclaredProcedure Bool
True forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {b}. b -> ((Int, ParsedLexemes, Int), b)
wrap forall a b. (a -> b) -> a -> b
$
forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
[f (FPSection l' l' f' f')]
-> Maybe (ReturnType l') -> FormalParameters l l' f' f
Abstract.formalParameters [forall {b}. b -> ((Int, ParsedLexemes, Int), b)
wrap forall a b. (a -> b) -> a -> b
$ forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
Bool -> [Text] -> f (Type l' l' f' f') -> FPSection l l' f' f
Abstract.fpSection Bool
False (forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"n") forall a b. (a -> b) -> a -> b
$ forall {b}. b -> ((Int, ParsedLexemes, Int), b)
wrap
forall a b. (a -> b) -> a -> b
$ forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
QualIdent l' -> Type l l' f' f
Abstract.typeReference forall a b. (a -> b) -> a -> b
$ forall l. Wirthy l => Text -> QualIdent l
Abstract.nonQualIdent Text
"CHAR"] forall a b. (a -> b) -> a -> b
$
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall l. Wirthy l => Text -> QualIdent l
Abstract.nonQualIdent Text
"INTEGER"),
(Text
"ORD", forall l (f' :: * -> *) (f :: * -> *).
Bool
-> Maybe (f (FormalParameters l l f' f')) -> DeclarationRHS l f' f
DeclaredProcedure Bool
False forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {b}. b -> ((Int, ParsedLexemes, Int), b)
wrap forall a b. (a -> b) -> a -> b
$
forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
[f (FPSection l' l' f' f')]
-> Maybe (ReturnType l') -> FormalParameters l l' f' f
Abstract.formalParameters [forall {b}. b -> ((Int, ParsedLexemes, Int), b)
wrap forall a b. (a -> b) -> a -> b
$ forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
Bool -> [Text] -> f (Type l' l' f' f') -> FPSection l l' f' f
Abstract.fpSection Bool
False (forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"n") forall a b. (a -> b) -> a -> b
$ forall {b}. b -> ((Int, ParsedLexemes, Int), b)
wrap
forall a b. (a -> b) -> a -> b
$ forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
QualIdent l' -> Type l l' f' f
Abstract.typeReference forall a b. (a -> b) -> a -> b
$ forall l. Wirthy l => Text -> QualIdent l
Abstract.nonQualIdent Text
"CHAR"] forall a b. (a -> b) -> a -> b
$
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall l. Wirthy l => Text -> QualIdent l
Abstract.nonQualIdent Text
"INTEGER"),
(Text
"CHR", forall l (f' :: * -> *) (f :: * -> *).
Bool
-> Maybe (f (FormalParameters l l f' f')) -> DeclarationRHS l f' f
DeclaredProcedure Bool
False forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {b}. b -> ((Int, ParsedLexemes, Int), b)
wrap forall a b. (a -> b) -> a -> b
$
forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
[f (FPSection l' l' f' f')]
-> Maybe (ReturnType l') -> FormalParameters l l' f' f
Abstract.formalParameters [forall {b}. b -> ((Int, ParsedLexemes, Int), b)
wrap forall a b. (a -> b) -> a -> b
$ forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
Bool -> [Text] -> f (Type l' l' f' f') -> FPSection l l' f' f
Abstract.fpSection Bool
False (forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"n") forall a b. (a -> b) -> a -> b
$ forall {b}. b -> ((Int, ParsedLexemes, Int), b)
wrap
forall a b. (a -> b) -> a -> b
$ forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
QualIdent l' -> Type l l' f' f
Abstract.typeReference forall a b. (a -> b) -> a -> b
$ forall l. Wirthy l => Text -> QualIdent l
Abstract.nonQualIdent Text
"INTEGER"] forall a b. (a -> b) -> a -> b
$
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall l. Wirthy l => Text -> QualIdent l
Abstract.nonQualIdent Text
"CHAR"),
(Text
"SHORT", forall l (f' :: * -> *) (f :: * -> *).
Bool
-> Maybe (f (FormalParameters l l f' f')) -> DeclarationRHS l f' f
DeclaredProcedure Bool
False forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {b}. b -> ((Int, ParsedLexemes, Int), b)
wrap forall a b. (a -> b) -> a -> b
$
forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
[f (FPSection l' l' f' f')]
-> Maybe (ReturnType l') -> FormalParameters l l' f' f
Abstract.formalParameters [forall {b}. b -> ((Int, ParsedLexemes, Int), b)
wrap forall a b. (a -> b) -> a -> b
$ forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
Bool -> [Text] -> f (Type l' l' f' f') -> FPSection l l' f' f
Abstract.fpSection Bool
False (forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"n") forall a b. (a -> b) -> a -> b
$ forall {b}. b -> ((Int, ParsedLexemes, Int), b)
wrap
forall a b. (a -> b) -> a -> b
$ forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
QualIdent l' -> Type l l' f' f
Abstract.typeReference forall a b. (a -> b) -> a -> b
$ forall l. Wirthy l => Text -> QualIdent l
Abstract.nonQualIdent Text
"INTEGER"] forall a b. (a -> b) -> a -> b
$
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall l. Wirthy l => Text -> QualIdent l
Abstract.nonQualIdent Text
"INTEGER"),
(Text
"LONG", forall l (f' :: * -> *) (f :: * -> *).
Bool
-> Maybe (f (FormalParameters l l f' f')) -> DeclarationRHS l f' f
DeclaredProcedure Bool
False forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {b}. b -> ((Int, ParsedLexemes, Int), b)
wrap forall a b. (a -> b) -> a -> b
$
forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
[f (FPSection l' l' f' f')]
-> Maybe (ReturnType l') -> FormalParameters l l' f' f
Abstract.formalParameters [forall {b}. b -> ((Int, ParsedLexemes, Int), b)
wrap forall a b. (a -> b) -> a -> b
$ forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
Bool -> [Text] -> f (Type l' l' f' f') -> FPSection l l' f' f
Abstract.fpSection Bool
False (forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"n") forall a b. (a -> b) -> a -> b
$ forall {b}. b -> ((Int, ParsedLexemes, Int), b)
wrap
forall a b. (a -> b) -> a -> b
$ forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
QualIdent l' -> Type l l' f' f
Abstract.typeReference forall a b. (a -> b) -> a -> b
$ forall l. Wirthy l => Text -> QualIdent l
Abstract.nonQualIdent Text
"INTEGER"] forall a b. (a -> b) -> a -> b
$
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall l. Wirthy l => Text -> QualIdent l
Abstract.nonQualIdent Text
"INTEGER"),
(Text
"ENTIER", forall l (f' :: * -> *) (f :: * -> *).
Bool
-> Maybe (f (FormalParameters l l f' f')) -> DeclarationRHS l f' f
DeclaredProcedure Bool
False forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {b}. b -> ((Int, ParsedLexemes, Int), b)
wrap forall a b. (a -> b) -> a -> b
$
forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
[f (FPSection l' l' f' f')]
-> Maybe (ReturnType l') -> FormalParameters l l' f' f
Abstract.formalParameters [forall {b}. b -> ((Int, ParsedLexemes, Int), b)
wrap forall a b. (a -> b) -> a -> b
$ forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
Bool -> [Text] -> f (Type l' l' f' f') -> FPSection l l' f' f
Abstract.fpSection Bool
False (forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"n") forall a b. (a -> b) -> a -> b
$ forall {b}. b -> ((Int, ParsedLexemes, Int), b)
wrap
forall a b. (a -> b) -> a -> b
$ forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
QualIdent l' -> Type l l' f' f
Abstract.typeReference forall a b. (a -> b) -> a -> b
$ forall l. Wirthy l => Text -> QualIdent l
Abstract.nonQualIdent Text
"REAL"] forall a b. (a -> b) -> a -> b
$
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall l. Wirthy l => Text -> QualIdent l
Abstract.nonQualIdent Text
"INTEGER"),
(Text
"INC", forall l (f' :: * -> *) (f :: * -> *).
Bool
-> Maybe (f (FormalParameters l l f' f')) -> DeclarationRHS l f' f
DeclaredProcedure Bool
False forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {b}. b -> ((Int, ParsedLexemes, Int), b)
wrap forall a b. (a -> b) -> a -> b
$
forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
[f (FPSection l' l' f' f')]
-> Maybe (ReturnType l') -> FormalParameters l l' f' f
Abstract.formalParameters [forall {b}. b -> ((Int, ParsedLexemes, Int), b)
wrap forall a b. (a -> b) -> a -> b
$ forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
Bool -> [Text] -> f (Type l' l' f' f') -> FPSection l l' f' f
Abstract.fpSection Bool
False (forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"n") forall a b. (a -> b) -> a -> b
$ forall {b}. b -> ((Int, ParsedLexemes, Int), b)
wrap
forall a b. (a -> b) -> a -> b
$ forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
QualIdent l' -> Type l l' f' f
Abstract.typeReference forall a b. (a -> b) -> a -> b
$ forall l. Wirthy l => Text -> QualIdent l
Abstract.nonQualIdent Text
"INTEGER"] forall a. Maybe a
Nothing),
(Text
"DEC", forall l (f' :: * -> *) (f :: * -> *).
Bool
-> Maybe (f (FormalParameters l l f' f')) -> DeclarationRHS l f' f
DeclaredProcedure Bool
False forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {b}. b -> ((Int, ParsedLexemes, Int), b)
wrap forall a b. (a -> b) -> a -> b
$
forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
[f (FPSection l' l' f' f')]
-> Maybe (ReturnType l') -> FormalParameters l l' f' f
Abstract.formalParameters [forall {b}. b -> ((Int, ParsedLexemes, Int), b)
wrap forall a b. (a -> b) -> a -> b
$ forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
Bool -> [Text] -> f (Type l' l' f' f') -> FPSection l l' f' f
Abstract.fpSection Bool
False (forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"n") forall a b. (a -> b) -> a -> b
$ forall {b}. b -> ((Int, ParsedLexemes, Int), b)
wrap
forall a b. (a -> b) -> a -> b
$ forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
QualIdent l' -> Type l l' f' f
Abstract.typeReference forall a b. (a -> b) -> a -> b
$ forall l. Wirthy l => Text -> QualIdent l
Abstract.nonQualIdent Text
"INTEGER"] forall a. Maybe a
Nothing),
(Text
"INCL", forall l (f' :: * -> *) (f :: * -> *).
Bool
-> Maybe (f (FormalParameters l l f' f')) -> DeclarationRHS l f' f
DeclaredProcedure Bool
False forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {b}. b -> ((Int, ParsedLexemes, Int), b)
wrap forall a b. (a -> b) -> a -> b
$
forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
[f (FPSection l' l' f' f')]
-> Maybe (ReturnType l') -> FormalParameters l l' f' f
Abstract.formalParameters [forall {b}. b -> ((Int, ParsedLexemes, Int), b)
wrap forall a b. (a -> b) -> a -> b
$ forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
Bool -> [Text] -> f (Type l' l' f' f') -> FPSection l l' f' f
Abstract.fpSection Bool
False (forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"s") forall a b. (a -> b) -> a -> b
$ forall {b}. b -> ((Int, ParsedLexemes, Int), b)
wrap
forall a b. (a -> b) -> a -> b
$ forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
QualIdent l' -> Type l l' f' f
Abstract.typeReference forall a b. (a -> b) -> a -> b
$ forall l. Wirthy l => Text -> QualIdent l
Abstract.nonQualIdent Text
"SET",
forall {b}. b -> ((Int, ParsedLexemes, Int), b)
wrap forall a b. (a -> b) -> a -> b
$ forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
Bool -> [Text] -> f (Type l' l' f' f') -> FPSection l l' f' f
Abstract.fpSection Bool
False (forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"n") forall a b. (a -> b) -> a -> b
$ forall {b}. b -> ((Int, ParsedLexemes, Int), b)
wrap
forall a b. (a -> b) -> a -> b
$ forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
QualIdent l' -> Type l l' f' f
Abstract.typeReference forall a b. (a -> b) -> a -> b
$ forall l. Wirthy l => Text -> QualIdent l
Abstract.nonQualIdent Text
"INTEGER"] forall a. Maybe a
Nothing),
(Text
"EXCL", forall l (f' :: * -> *) (f :: * -> *).
Bool
-> Maybe (f (FormalParameters l l f' f')) -> DeclarationRHS l f' f
DeclaredProcedure Bool
False forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {b}. b -> ((Int, ParsedLexemes, Int), b)
wrap forall a b. (a -> b) -> a -> b
$
forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
[f (FPSection l' l' f' f')]
-> Maybe (ReturnType l') -> FormalParameters l l' f' f
Abstract.formalParameters [forall {b}. b -> ((Int, ParsedLexemes, Int), b)
wrap forall a b. (a -> b) -> a -> b
$ forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
Bool -> [Text] -> f (Type l' l' f' f') -> FPSection l l' f' f
Abstract.fpSection Bool
False (forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"s") forall a b. (a -> b) -> a -> b
$ forall {b}. b -> ((Int, ParsedLexemes, Int), b)
wrap
forall a b. (a -> b) -> a -> b
$ forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
QualIdent l' -> Type l l' f' f
Abstract.typeReference forall a b. (a -> b) -> a -> b
$ forall l. Wirthy l => Text -> QualIdent l
Abstract.nonQualIdent Text
"SET",
forall {b}. b -> ((Int, ParsedLexemes, Int), b)
wrap forall a b. (a -> b) -> a -> b
$ forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
Bool -> [Text] -> f (Type l' l' f' f') -> FPSection l l' f' f
Abstract.fpSection Bool
False (forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"n") forall a b. (a -> b) -> a -> b
$ forall {b}. b -> ((Int, ParsedLexemes, Int), b)
wrap
forall a b. (a -> b) -> a -> b
$ forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
QualIdent l' -> Type l l' f' f
Abstract.typeReference forall a b. (a -> b) -> a -> b
$ forall l. Wirthy l => Text -> QualIdent l
Abstract.nonQualIdent Text
"INTEGER"] forall a. Maybe a
Nothing),
(Text
"COPY", forall l (f' :: * -> *) (f :: * -> *).
Bool
-> Maybe (f (FormalParameters l l f' f')) -> DeclarationRHS l f' f
DeclaredProcedure Bool
False forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {b}. b -> ((Int, ParsedLexemes, Int), b)
wrap forall a b. (a -> b) -> a -> b
$
forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
[f (FPSection l' l' f' f')]
-> Maybe (ReturnType l') -> FormalParameters l l' f' f
Abstract.formalParameters [forall {b}. b -> ((Int, ParsedLexemes, Int), b)
wrap forall a b. (a -> b) -> a -> b
$ forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
Bool -> [Text] -> f (Type l' l' f' f') -> FPSection l l' f' f
Abstract.fpSection Bool
False (forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"s") forall a b. (a -> b) -> a -> b
$ forall {b}. b -> ((Int, ParsedLexemes, Int), b)
wrap
forall a b. (a -> b) -> a -> b
$ forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
QualIdent l' -> Type l l' f' f
Abstract.typeReference forall a b. (a -> b) -> a -> b
$ forall l. Wirthy l => Text -> QualIdent l
Abstract.nonQualIdent Text
"ARRAY",
forall {b}. b -> ((Int, ParsedLexemes, Int), b)
wrap forall a b. (a -> b) -> a -> b
$ forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
Bool -> [Text] -> f (Type l' l' f' f') -> FPSection l l' f' f
Abstract.fpSection Bool
False (forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"n") forall a b. (a -> b) -> a -> b
$ forall {b}. b -> ((Int, ParsedLexemes, Int), b)
wrap
forall a b. (a -> b) -> a -> b
$ forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
QualIdent l' -> Type l l' f' f
Abstract.typeReference forall a b. (a -> b) -> a -> b
$ forall l. Wirthy l => Text -> QualIdent l
Abstract.nonQualIdent Text
"ARRAY"] forall a. Maybe a
Nothing),
(Text
"NEW", forall l (f' :: * -> *) (f :: * -> *).
Bool
-> Maybe (f (FormalParameters l l f' f')) -> DeclarationRHS l f' f
DeclaredProcedure Bool
False forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {b}. b -> ((Int, ParsedLexemes, Int), b)
wrap forall a b. (a -> b) -> a -> b
$
forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
[f (FPSection l' l' f' f')]
-> Maybe (ReturnType l') -> FormalParameters l l' f' f
Abstract.formalParameters [forall {b}. b -> ((Int, ParsedLexemes, Int), b)
wrap forall a b. (a -> b) -> a -> b
$ forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
Bool -> [Text] -> f (Type l' l' f' f') -> FPSection l l' f' f
Abstract.fpSection Bool
False (forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"n") forall a b. (a -> b) -> a -> b
$ forall {b}. b -> ((Int, ParsedLexemes, Int), b)
wrap
forall a b. (a -> b) -> a -> b
$ forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
QualIdent l' -> Type l l' f' f
Abstract.typeReference forall a b. (a -> b) -> a -> b
$ forall l. Wirthy l => Text -> QualIdent l
Abstract.nonQualIdent Text
"POINTER"] forall a. Maybe a
Nothing),
(Text
"HALT", forall l (f' :: * -> *) (f :: * -> *).
Bool
-> Maybe (f (FormalParameters l l f' f')) -> DeclarationRHS l f' f
DeclaredProcedure Bool
False forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {b}. b -> ((Int, ParsedLexemes, Int), b)
wrap forall a b. (a -> b) -> a -> b
$
forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
[f (FPSection l' l' f' f')]
-> Maybe (ReturnType l') -> FormalParameters l l' f' f
Abstract.formalParameters [forall {b}. b -> ((Int, ParsedLexemes, Int), b)
wrap forall a b. (a -> b) -> a -> b
$ forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
Bool -> [Text] -> f (Type l' l' f' f') -> FPSection l l' f' f
Abstract.fpSection Bool
False (forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"n") forall a b. (a -> b) -> a -> b
$ forall {b}. b -> ((Int, ParsedLexemes, Int), b)
wrap
forall a b. (a -> b) -> a -> b
$ forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
QualIdent l' -> Type l l' f' f
Abstract.typeReference forall a b. (a -> b) -> a -> b
$ forall l. Wirthy l => Text -> QualIdent l
Abstract.nonQualIdent Text
"INTEGER"] forall a. Maybe a
Nothing)]
predefined2 :: forall l. Oberon l => Predefined l
predefined2 = forall l. Oberon l => Predefined l
predefined forall a. Semigroup a => a -> a -> a
<>
(forall e a. a -> Validation e a
Success forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
[(Text
"ASSERT",
forall l (f' :: * -> *) (f :: * -> *).
Bool
-> Maybe (f (FormalParameters l l f' f')) -> DeclarationRHS l f' f
DeclaredProcedure Bool
False forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {b}. b -> ((Int, ParsedLexemes, Int), b)
wrap forall a b. (a -> b) -> a -> b
$ forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
[f (FPSection l' l' f' f')]
-> Maybe (ReturnType l') -> FormalParameters l l' f' f
Abstract.formalParameters
[forall {b}. b -> ((Int, ParsedLexemes, Int), b)
wrap forall a b. (a -> b) -> a -> b
$ forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
Bool -> [Text] -> f (Type l' l' f' f') -> FPSection l l' f' f
Abstract.fpSection Bool
False (forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"s") forall a b. (a -> b) -> a -> b
$ forall {b}. b -> ((Int, ParsedLexemes, Int), b)
wrap forall a b. (a -> b) -> a -> b
$ forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
QualIdent l' -> Type l l' f' f
Abstract.typeReference forall a b. (a -> b) -> a -> b
$ forall l. Wirthy l => Text -> QualIdent l
Abstract.nonQualIdent Text
"ARRAY",
forall {b}. b -> ((Int, ParsedLexemes, Int), b)
wrap forall a b. (a -> b) -> a -> b
$ forall l (f :: * -> *) l' (f' :: * -> *).
Wirthy l =>
Bool -> [Text] -> f (Type l' l' f' f') -> FPSection l l' f' f
Abstract.fpSection Bool
False (forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"n") forall a b. (a -> b) -> a -> b
$ forall {b}. b -> ((Int, ParsedLexemes, Int), b)
wrap forall a b. (a -> b) -> a -> b
$ forall l l' (f' :: * -> *) (f :: * -> *).
Wirthy l =>
QualIdent l' -> Type l l' f' f
Abstract.typeReference forall a b. (a -> b) -> a -> b
$ forall l. Wirthy l => Text -> QualIdent l
Abstract.nonQualIdent Text
"ARRAY"]
forall a. Maybe a
Nothing)])
wrap :: b -> ((Int, ParsedLexemes, Int), b)
wrap = (,) (Int
0, [Lexeme] -> ParsedLexemes
Trailing [], Int
0)
exportsOfModule :: (BindableDeclaration l, CoFormalParameters l) => Module l l Placed Placed -> Scope l
exportsOfModule :: forall l.
(BindableDeclaration l, CoFormalParameters l) =>
Module l l Placed Placed -> Scope l
exportsOfModule = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall e a. a -> Validation e a
Success forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe forall {a}. (AccessMode, a) -> Maybe a
isExported forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l.
(BindableDeclaration l, CoFormalParameters l) =>
Module l l Placed Placed
-> Map Text (AccessMode, DeclarationRHS l Placed Placed)
globalsOfModule
where isExported :: (AccessMode, a) -> Maybe a
isExported (AccessMode
PrivateOnly, a
_) = forall a. Maybe a
Nothing
isExported (AccessMode
_, a
binding) = forall a. a -> Maybe a
Just a
binding
globalsOfModule :: forall l. (BindableDeclaration l, CoFormalParameters l) =>
Module l l Placed Placed -> Map Ident (AccessMode, DeclarationRHS l Placed Placed)
globalsOfModule :: forall l.
(BindableDeclaration l, CoFormalParameters l) =>
Module l l Placed Placed
-> Map Text (AccessMode, DeclarationRHS l Placed Placed)
globalsOfModule (Module Text
name [Import l]
imports ((Int, ParsedLexemes, Int)
_, Block l l Placed Placed
body)) =
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall l (f :: * -> *).
(BindableDeclaration l, Foldable f) =>
Text
-> Declaration l l f f
-> [(Text, (AccessMode, DeclarationRHS l f f))]
declarationBinding Text
name forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) (forall l (f' :: * -> *) (f :: * -> *).
CoFormalParameters l =>
Block l l f' f -> [f (Declaration l l f' f')]
getLocalDeclarations Block l l Placed Placed
body))
unique :: (NonEmpty (Error l) -> Error l) -> ([a] -> Error l) -> NodeWrap (Validation (NonEmpty (Error l)) a)
-> Validation (NonEmpty (Error l)) (Placed a)
unique :: forall l a.
(NonEmpty (Error l) -> Error l)
-> ([a] -> Error l)
-> NodeWrap (Validation (NonEmpty (Error l)) a)
-> Validation (NonEmpty (Error l)) (Placed a)
unique NonEmpty (Error l) -> Error l
_ [a] -> Error l
_ (Compose ((Int
start, Int
end), Compose (Ambiguous ((ParsedLexemes, Validation (NonEmpty (Error l)) a)
x :| [])))) = forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (forall a b c. (a -> b -> c) -> b -> a -> c
flip ((,,) Int
start) Int
end) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA (ParsedLexemes, Validation (NonEmpty (Error l)) a)
x)
unique NonEmpty (Error l) -> Error l
inv [a] -> Error l
amb (Compose ((Int
start, Int
end), Compose (Ambiguous NonEmpty (ParsedLexemes, Validation (NonEmpty (Error l)) a)
xs))) =
case forall a b. [Either a b] -> ([a], [b])
partitionEithers (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall e a. Validation e a -> Either e a
validationToEither forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty (ParsedLexemes, Validation (NonEmpty (Error l)) a)
xs)
of ([NonEmpty (Error l)]
_, [(ParsedLexemes
ws, a
x)]) -> forall e a. a -> Validation e a
Success ((Int
start, ParsedLexemes
ws, Int
end), a
x)
([NonEmpty (Error l)]
errors, []) -> forall e a. e -> Validation e a
Failure (NonEmpty (Error l) -> Error l
inv (forall a. Semigroup a => NonEmpty a -> a
sconcat forall a b. (a -> b) -> a -> b
$ forall a. [a] -> NonEmpty a
NonEmpty.fromList [NonEmpty (Error l)]
errors) forall a. a -> [a] -> NonEmpty a
:| [])
([NonEmpty (Error l)]
_, [(ParsedLexemes, a)]
multi) -> forall e a. e -> Validation e a
Failure ([a] -> Error l
amb (forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(ParsedLexemes, a)]
multi) forall a. a -> [a] -> NonEmpty a
:| [])
$(Rank2.TH.deriveFunctor ''DeclarationRHS)
$(Rank2.TH.deriveFoldable ''DeclarationRHS)
$(Rank2.TH.deriveTraversable ''DeclarationRHS)
$(Transformation.Deep.TH.deriveTraversable ''DeclarationRHS)
$(do l <- varT <$> newName "l"
mconcat <$> mapM (\t-> Transformation.Full.TH.deriveDownTraversable (conT ''Resolution `appT` l)
$ conT t `appT` l `appT` l)
[''Module, ''Declaration, ''Type, ''FieldList,
''ProcedureHeading, ''FormalParameters, ''FPSection,
''Expression, ''Element, ''Designator,
''Block, ''StatementSequence, ''Statement,
''Case, ''CaseLabels, ''ConditionalBranch, ''Value, ''WithAlternative])