{-# LANGUAGE FlexibleContexts, FlexibleInstances, KindSignatures, MultiParamTypeClasses, OverloadedStrings,
             ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TypeFamilies, TypeOperators,
             UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-simplifiable-class-constraints #-}

-- | This module exports functions for resolving the syntactic ambiguities in a parsed module. For example, an Oberon
-- expression @foo(bar)@ may be a call to function @foo@ with a parameter @bar@, or it may be type guard on variable
-- @foo@ casting it to type @bar@.

module Language.Oberon.Resolver (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

-- | Replace the stored positions in the entire ambiguous parsed tree, as obtained from "Language.Oberon.Grammar",
-- | with offsets from the start of the given source text
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

-- | Replace the stored positions of the given node, as obtained from "Language.Oberon.Grammar", with offset from the
-- | start of the given source text
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)

-- | All possible resolution errors
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)

-- | The node wrapper in a fully resolved AST
type Placed = (,) (Int, ParsedLexemes, Int)

-- | The node wrapper in an ambiguous, freshly parsed AST, only with 'Position.Position' replaced with an offset from
-- the beginning of the source.
type NodeWrap = Compose ((,) (Int, Int)) (Compose Ambiguous ((,) ParsedLexemes))

type Scope l = Map Ident (Validation (NonEmpty (Error l)) (DeclarationRHS l Placed Placed))

-- | A set of predefined declarations.
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
:| [])

-- | Resolve ambiguities in the given collection of modules, a 'Map' keyed by module name. The value for the first
-- argument is typically 'predefined' or 'predefined2'. Note that all class constraints in the function's type
-- signature are satisfied by the Oberon 'Language'.
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

-- | Resolve ambiguities in a single module. The value for the first argument is typically 'predefined' or
-- 'predefined2'. The imports are resolved using the given map of already resolved modules. Note that all class
-- constraints in the function's type signature are satisfied by the Oberon 'Language'.
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
-- | The set of 'Predefined' types and procedures defined in the Oberon Language Report.
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)]

-- | The set of 'Predefined' types and procedures defined in the Oberon-2 Language Report.
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])