{-# LANGUAGE DataKinds, DeriveGeneric, DuplicateRecordFields, FlexibleContexts, FlexibleInstances,
             MultiParamTypeClasses, NamedFieldPuns, OverloadedRecordDot, OverloadedStrings,
             ScopedTypeVariables, StandaloneDeriving,
             TypeFamilies, TypeOperators, UndecidableInstances, ViewPatterns #-}

-- | Type checker for Oberon AST. The AST must have its ambiguities previously resolved by "Language.Oberon.Resolver".
module Language.Oberon.TypeChecker (checkModules, errorMessage, Error(..), ErrorType(..), predefined, predefined2) where

import Control.Applicative (liftA2, (<|>), ZipList(ZipList, getZipList))
import Control.Arrow (first)
import Data.Coerce (coerce)
import Data.Proxy (Proxy(..))
import qualified Data.List as List
import Data.Functor.Const (Const(..))
import Data.Maybe (fromMaybe)
import Data.Map.Lazy (Map)
import qualified Data.Map.Lazy as Map
import Data.Semigroup (Semigroup(..))
import qualified Data.Text as Text
import GHC.Generics (Generic)

import qualified Rank2
import qualified Transformation
import qualified Transformation.Shallow as Shallow
import qualified Transformation.Deep as Deep
import qualified Transformation.Full as Full
import qualified Transformation.Full.TH
import qualified Transformation.AG as AG
import qualified Transformation.AG.Generics as AG
import Transformation.AG (Attribution(..), Atts, Inherited(..), Synthesized(..), Semantics)
import Transformation.AG.Generics (Auto(Auto), Folded(..), Bequether(..), Synthesizer(..), SynthesizedField)

import qualified Language.Oberon.Abstract as Abstract
import qualified Language.Oberon.AST as AST
import Language.Oberon.Grammar (ParsedLexemes(Trailing))
import Language.Oberon.Resolver (Placed)

data Type l = NominalType (Abstract.QualIdent l) (Maybe (Type l))
            | RecordType{forall l. Type l -> [QualIdent l]
ancestry :: [Abstract.QualIdent l],
                         forall l. Type l -> Map Ident (Type l)
recordFields :: Map AST.Ident (Type l)}
            | NilType
            | IntegerType Int
            | StringType Int
            | ArrayType [Int] (Type l)
            | PointerType (Type l)
            | ReceiverType (Type l)
            | ProcedureType Bool [(Bool, Type l)] (Maybe (Type l))
            | BuiltinType Text.Text
            | UnknownType

data ErrorType l = ArgumentCountMismatch Int Int
                 | ExtraDimensionalIndex Int Int
                 | IncomparableTypes (Type l) (Type l)
                 | IncompatibleTypes (Type l) (Type l)
                 | TooSmallArrayType Int Int
                 | OpenArrayVariable
                 | NonArrayType (Type l)
                 | NonBooleanType (Type l)
                 | NonFunctionType (Type l)
                 | NonIntegerType (Type l)
                 | NonNumericType (Type l)
                 | NonPointerType (Type l)
                 | NonProcedureType (Type l)
                 | NonRecordType (Type l)
                 | TypeMismatch (Type l) (Type l)
                 | UnequalTypes (Type l) (Type l)
                 | UnrealType (Type l)
                 | UnknownName (Abstract.QualIdent l)
                 | UnknownField AST.Ident (Type l)

data Error m l = Error{forall m l. Error m l -> m
errorModule   :: m,
                       forall m l. Error m l -> LexicalPosition
errorPosition :: LexicalPosition,
                       forall m l. Error m l -> ErrorType l
errorType     :: ErrorType l}

type LexicalPosition = (Int, ParsedLexemes, Int)

instance Eq (Abstract.QualIdent l) => Eq (Type l) where
  NominalType QualIdent l
q1 (Just Type l
t1) == :: Type l -> Type l -> Bool
== t2 :: Type l
t2@(NominalType QualIdent l
q2 Maybe (Type l)
_) = QualIdent l
q1 QualIdent l -> QualIdent l -> Bool
forall a. Eq a => a -> a -> Bool
== QualIdent l
q2 Bool -> Bool -> Bool
|| Type l
t1 Type l -> Type l -> Bool
forall a. Eq a => a -> a -> Bool
== Type l
t2
  t1 :: Type l
t1@(NominalType QualIdent l
q1 Maybe (Type l)
_) == NominalType QualIdent l
q2 (Just Type l
t2) = QualIdent l
q1 QualIdent l -> QualIdent l -> Bool
forall a. Eq a => a -> a -> Bool
== QualIdent l
q2 Bool -> Bool -> Bool
|| Type l
t1 Type l -> Type l -> Bool
forall a. Eq a => a -> a -> Bool
== Type l
t2
  NominalType QualIdent l
q1 Maybe (Type l)
Nothing == NominalType QualIdent l
q2 Maybe (Type l)
Nothing = QualIdent l
q1 QualIdent l -> QualIdent l -> Bool
forall a. Eq a => a -> a -> Bool
== QualIdent l
q2
  ArrayType [] Type l
t1 == ArrayType [] Type l
t2 = Type l
t1 Type l -> Type l -> Bool
forall a. Eq a => a -> a -> Bool
== Type l
t2
  ProcedureType Bool
_ [(Bool, Type l)]
p1 Maybe (Type l)
r1 == ProcedureType Bool
_ [(Bool, Type l)]
p2 Maybe (Type l)
r2 = Maybe (Type l)
r1 Maybe (Type l) -> Maybe (Type l) -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe (Type l)
r2 Bool -> Bool -> Bool
&& [(Bool, Type l)]
p1 [(Bool, Type l)] -> [(Bool, Type l)] -> Bool
forall a. Eq a => a -> a -> Bool
== [(Bool, Type l)]
p2
  StringType Int
len1 == StringType Int
len2 = Int
len1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
len2
  Type l
NilType == Type l
NilType = Bool
True
  BuiltinType Ident
name1 == BuiltinType Ident
name2 = Ident
name1 Ident -> Ident -> Bool
forall a. Eq a => a -> a -> Bool
== Ident
name2
  ReceiverType Type l
t1 == Type l
t2 = Type l
t1 Type l -> Type l -> Bool
forall a. Eq a => a -> a -> Bool
== Type l
t2
  Type l
t1 == ReceiverType Type l
t2 = Type l
t1 Type l -> Type l -> Bool
forall a. Eq a => a -> a -> Bool
== Type l
t2
  Type l
_ == Type l
_ = Bool
False

deriving instance Show (Abstract.QualIdent l) => Show (Type l)

deriving instance Eq (Abstract.QualIdent l) => Eq (ErrorType l)
deriving instance Show (Abstract.QualIdent l) => Show (ErrorType l)

deriving instance (Eq m, Eq (Abstract.QualIdent l)) => Eq (Error m l)
deriving instance (Show m, Show (Abstract.QualIdent l)) => Show (Error m l)

errorMessage :: (Abstract.Nameable l, Abstract.Oberon l, Show (Abstract.QualIdent l)) => ErrorType l -> String
errorMessage :: forall l.
(Nameable l, Oberon l, Show (QualIdent l)) =>
ErrorType l -> String
errorMessage (ArgumentCountMismatch Int
expected Int
actual) =
   String
"Expected " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
expected String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
", received " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
actual String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" arguments"
errorMessage (ExtraDimensionalIndex Int
expected Int
actual) =
   String
"Expected " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
expected String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
", received " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
actual String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" indexes"
errorMessage (IncomparableTypes Type l
left Type l
right) = 
   String
"Values of types " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Type l -> String
forall l. (Nameable l, Oberon l) => Type l -> String
typeMessage Type l
left String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" and " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Type l -> String
forall l. (Nameable l, Oberon l) => Type l -> String
typeMessage Type l
right String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" cannot be compared"
errorMessage (IncompatibleTypes Type l
left Type l
right) =
   String
"Incompatible types " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Type l -> String
forall l. (Nameable l, Oberon l) => Type l -> String
typeMessage Type l
left String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" and " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Type l -> String
forall l. (Nameable l, Oberon l) => Type l -> String
typeMessage Type l
right
errorMessage (TooSmallArrayType Int
expected Int
actual) = 
   String
"The array of length " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
expected String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" cannot contain " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
actual String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" items"
errorMessage ErrorType l
OpenArrayVariable = String
"A variable cannot be declared an open array"
errorMessage (NonArrayType Type l
t) = String
"Trying to index a non-array type " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Type l -> String
forall l. (Nameable l, Oberon l) => Type l -> String
typeMessage Type l
t
errorMessage (NonBooleanType Type l
t) = String
"Type " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Type l -> String
forall l. (Nameable l, Oberon l) => Type l -> String
typeMessage Type l
t String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" is not Boolean"
errorMessage (NonFunctionType Type l
t) = String
"Trying to invoke a " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Type l -> String
forall l. (Nameable l, Oberon l) => Type l -> String
typeMessage Type l
t String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" as a function"
errorMessage (NonIntegerType Type l
t) = String
"Type " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Type l -> String
forall l. (Nameable l, Oberon l) => Type l -> String
typeMessage Type l
t String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" is not an integer type"
errorMessage (NonNumericType Type l
t) = String
"Type " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Type l -> String
forall l. (Nameable l, Oberon l) => Type l -> String
typeMessage Type l
t String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" is not a numeric type"
errorMessage (NonPointerType Type l
t) = String
"Trying to dereference a non-pointer type " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Type l -> String
forall l. (Nameable l, Oberon l) => Type l -> String
typeMessage Type l
t
errorMessage (NonProcedureType Type l
t) = String
"Trying to invoke a " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Type l -> String
forall l. (Nameable l, Oberon l) => Type l -> String
typeMessage Type l
t String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" as a procedure"
errorMessage (NonRecordType Type l
t) = String
"Non-record type " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Type l -> String
forall l. (Nameable l, Oberon l) => Type l -> String
typeMessage Type l
t
errorMessage (TypeMismatch Type l
t1 Type l
t2) = String
"Type mismatch between " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Type l -> String
forall l. (Nameable l, Oberon l) => Type l -> String
typeMessage Type l
t1 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" and " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Type l -> String
forall l. (Nameable l, Oberon l) => Type l -> String
typeMessage Type l
t2
errorMessage (UnequalTypes Type l
t1 Type l
t2) = String
"Unequal types " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Type l -> String
forall l. (Nameable l, Oberon l) => Type l -> String
typeMessage Type l
t1 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" and " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Type l -> String
forall l. (Nameable l, Oberon l) => Type l -> String
typeMessage Type l
t2
errorMessage (UnrealType Type l
t) = String
"Type " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Type l -> String
forall l. (Nameable l, Oberon l) => Type l -> String
typeMessage Type l
t String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" is not a numeric real type"
errorMessage (UnknownName QualIdent l
q) = String
"Unknown name " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> QualIdent l -> String
forall a. Show a => a -> String
show QualIdent l
q
errorMessage (UnknownField Ident
name Type l
t) = String
"Record type " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Type l -> String
forall l. (Nameable l, Oberon l) => Type l -> String
typeMessage Type l
t String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" has no field " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Ident -> String
forall a. Show a => a -> String
show Ident
name

typeMessage :: (Abstract.Nameable l, Abstract.Oberon l) => Type l -> String
typeMessage :: forall l. (Nameable l, Oberon l) => Type l -> String
typeMessage (BuiltinType Ident
name) = Ident -> String
Text.unpack Ident
name
typeMessage (NominalType QualIdent l
name Maybe (Type l)
_) = QualIdent l -> String
forall l. (Nameable l, Oberon l) => QualIdent l -> String
nameMessage QualIdent l
name
typeMessage (RecordType [QualIdent l]
ancestry Map Ident (Type l)
fields) = 
   String
"RECORD " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (QualIdent l -> String) -> [QualIdent l] -> String
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((String
"(" String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> (QualIdent l -> String) -> QualIdent l -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
") ") ShowS -> (QualIdent l -> String) -> QualIdent l -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QualIdent l -> String
forall l. (Nameable l, Oberon l) => QualIdent l -> String
nameMessage) [QualIdent l]
ancestry
   String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
List.intercalate String
";\n" ((Ident, Type l) -> String
forall {l}. (Nameable l, Oberon l) => (Ident, Type l) -> String
fieldMessage ((Ident, Type l) -> String) -> [(Ident, Type l)] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Ident (Type l) -> [(Ident, Type l)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Ident (Type l)
fields) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"END"
   where fieldMessage :: (Ident, Type l) -> String
fieldMessage (Ident
name, Type l
t) = String
"\n  " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Ident -> String
Text.unpack Ident
name String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
": " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Type l -> String
forall l. (Nameable l, Oberon l) => Type l -> String
typeMessage Type l
t
typeMessage (ArrayType [Int]
dimensions Type l
itemType) = 
   String
"ARRAY " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
List.intercalate String
", " (Int -> String
forall a. Show a => a -> String
show (Int -> String) -> [Int] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int]
dimensions) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" OF " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Type l -> String
forall l. (Nameable l, Oberon l) => Type l -> String
typeMessage Type l
itemType
typeMessage (PointerType Type l
targetType) = String
"POINTER TO " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Type l -> String
forall l. (Nameable l, Oberon l) => Type l -> String
typeMessage Type l
targetType
typeMessage (ProcedureType Bool
_ [(Bool, Type l)]
parameters Maybe (Type l)
result) =
   String
"PROCEDURE (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
List.intercalate String
", " ((Bool, Type l) -> String
forall {l}. (Nameable l, Oberon l) => (Bool, Type l) -> String
argMessage ((Bool, Type l) -> String) -> [(Bool, Type l)] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Bool, Type l)]
parameters) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"): " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Type l -> String) -> Maybe (Type l) -> String
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Type l -> String
forall l. (Nameable l, Oberon l) => Type l -> String
typeMessage Maybe (Type l)
result
   where argMessage :: (Bool, Type l) -> String
argMessage (Bool
True, Type l
t) = String
"VAR " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Type l -> String
forall l. (Nameable l, Oberon l) => Type l -> String
typeMessage Type l
t
         argMessage (Bool
False, Type l
t) = Type l -> String
forall l. (Nameable l, Oberon l) => Type l -> String
typeMessage Type l
t
typeMessage (ReceiverType Type l
t) = Type l -> String
forall l. (Nameable l, Oberon l) => Type l -> String
typeMessage Type l
t
typeMessage (IntegerType Int
n) = String
"INTEGER"
typeMessage (StringType Int
len) = String
"STRING [" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> ShowS
forall a. Show a => a -> ShowS
shows Int
len String
"]"
typeMessage Type l
NilType = String
"NIL"
typeMessage Type l
UnknownType = String
"[Unknown]"

nameMessage :: (Abstract.Nameable l, Abstract.Oberon l) => Abstract.QualIdent l -> String
nameMessage :: forall l. (Nameable l, Oberon l) => QualIdent l -> String
nameMessage QualIdent l
q
   | Just (Ident
mod, Ident
name) <- QualIdent l -> Maybe (Ident, Ident)
forall l. Oberon l => QualIdent l -> Maybe (Ident, Ident)
Abstract.getQualIdentNames QualIdent l
q = Ident -> String
Text.unpack Ident
mod String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"." String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Ident -> String
Text.unpack Ident
name
   | Just Ident
name <- QualIdent l -> Maybe Ident
forall l. Nameable l => QualIdent l -> Maybe Ident
Abstract.getNonQualIdentName QualIdent l
q = Ident -> String
Text.unpack Ident
name

type Environment l = Map (Abstract.QualIdent l) (Type l)

newtype Modules l f' f = Modules (Map AST.Ident (f (AST.Module l l f' f')))

data TypeCheck = TypeCheck

type Sem = Semantics (Auto TypeCheck)

data InhTCRoot l = InhTCRoot{forall l. InhTCRoot l -> Environment l
rootEnv :: Environment l}

data InhTC l = InhTC{forall l. InhTC l -> Environment l
env :: Environment l}
               deriving (forall x. InhTC l -> Rep (InhTC l) x)
-> (forall x. Rep (InhTC l) x -> InhTC l) -> Generic (InhTC l)
forall x. Rep (InhTC l) x -> InhTC l
forall x. InhTC l -> Rep (InhTC l) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall l x. Rep (InhTC l) x -> InhTC l
forall l x. InhTC l -> Rep (InhTC l) x
$cfrom :: forall l x. InhTC l -> Rep (InhTC l) x
from :: forall x. InhTC l -> Rep (InhTC l) x
$cto :: forall l x. Rep (InhTC l) x -> InhTC l
to :: forall x. Rep (InhTC l) x -> InhTC l
Generic

data InhTCExp l = InhTCExp{forall l. InhTCExp l -> Environment l
env          :: Environment l,
                           forall l. InhTCExp l -> Type l
expectedType :: Type l}
                  deriving (forall x. InhTCExp l -> Rep (InhTCExp l) x)
-> (forall x. Rep (InhTCExp l) x -> InhTCExp l)
-> Generic (InhTCExp l)
forall x. Rep (InhTCExp l) x -> InhTCExp l
forall x. InhTCExp l -> Rep (InhTCExp l) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall l x. Rep (InhTCExp l) x -> InhTCExp l
forall l x. InhTCExp l -> Rep (InhTCExp l) x
$cfrom :: forall l x. InhTCExp l -> Rep (InhTCExp l) x
from :: forall x. InhTCExp l -> Rep (InhTCExp l) x
$cto :: forall l x. Rep (InhTCExp l) x -> InhTCExp l
to :: forall x. Rep (InhTCExp l) x -> InhTCExp l
Generic

data InhTCDecl l = InhTCDecl{forall l. InhTCDecl l -> Environment l
env           :: Environment l,
                             forall l. InhTCDecl l -> Map Ident Ident
pointerTargets :: Map AST.Ident AST.Ident}
                   deriving (forall x. InhTCDecl l -> Rep (InhTCDecl l) x)
-> (forall x. Rep (InhTCDecl l) x -> InhTCDecl l)
-> Generic (InhTCDecl l)
forall x. Rep (InhTCDecl l) x -> InhTCDecl l
forall x. InhTCDecl l -> Rep (InhTCDecl l) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall l x. Rep (InhTCDecl l) x -> InhTCDecl l
forall l x. InhTCDecl l -> Rep (InhTCDecl l) x
$cfrom :: forall l x. InhTCDecl l -> Rep (InhTCDecl l) x
from :: forall x. InhTCDecl l -> Rep (InhTCDecl l) x
$cto :: forall l x. Rep (InhTCDecl l) x -> InhTCDecl l
to :: forall x. Rep (InhTCDecl l) x -> InhTCDecl l
Generic

data SynTC l = SynTC{forall l. SynTC l -> Folded [Error () l]
errors :: Folded [Error () l]}
               deriving (forall x. SynTC l -> Rep (SynTC l) x)
-> (forall x. Rep (SynTC l) x -> SynTC l) -> Generic (SynTC l)
forall x. Rep (SynTC l) x -> SynTC l
forall x. SynTC l -> Rep (SynTC l) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall l x. Rep (SynTC l) x -> SynTC l
forall l x. SynTC l -> Rep (SynTC l) x
$cfrom :: forall l x. SynTC l -> Rep (SynTC l) x
from :: forall x. SynTC l -> Rep (SynTC l) x
$cto :: forall l x. Rep (SynTC l) x -> SynTC l
to :: forall x. Rep (SynTC l) x -> SynTC l
Generic

data SynTCMods l = SynTCMods{forall l. SynTCMods l -> Folded [Error Ident l]
errors :: Folded [Error AST.Ident l]}
                   deriving (forall x. SynTCMods l -> Rep (SynTCMods l) x)
-> (forall x. Rep (SynTCMods l) x -> SynTCMods l)
-> Generic (SynTCMods l)
forall x. Rep (SynTCMods l) x -> SynTCMods l
forall x. SynTCMods l -> Rep (SynTCMods l) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall l x. Rep (SynTCMods l) x -> SynTCMods l
forall l x. SynTCMods l -> Rep (SynTCMods l) x
$cfrom :: forall l x. SynTCMods l -> Rep (SynTCMods l) x
from :: forall x. SynTCMods l -> Rep (SynTCMods l) x
$cto :: forall l x. Rep (SynTCMods l) x -> SynTCMods l
to :: forall x. Rep (SynTCMods l) x -> SynTCMods l
Generic

data SynTCMod l = SynTCMod{forall l. SynTCMod l -> Folded [Error () l]
errors :: Folded [Error () l],
                           forall l. SynTCMod l -> Environment l
moduleEnv :: Environment l,
                           forall l. SynTCMod l -> Folded (Map Ident Ident)
pointerTargets :: Folded (Map AST.Ident AST.Ident)}
                  deriving (forall x. SynTCMod l -> Rep (SynTCMod l) x)
-> (forall x. Rep (SynTCMod l) x -> SynTCMod l)
-> Generic (SynTCMod l)
forall x. Rep (SynTCMod l) x -> SynTCMod l
forall x. SynTCMod l -> Rep (SynTCMod l) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall l x. Rep (SynTCMod l) x -> SynTCMod l
forall l x. SynTCMod l -> Rep (SynTCMod l) x
$cfrom :: forall l x. SynTCMod l -> Rep (SynTCMod l) x
from :: forall x. SynTCMod l -> Rep (SynTCMod l) x
$cto :: forall l x. Rep (SynTCMod l) x -> SynTCMod l
to :: forall x. Rep (SynTCMod l) x -> SynTCMod l
Generic

data SynTCType l = SynTCType{forall l. SynTCType l -> Folded [Error () l]
errors :: Folded [Error () l],
                             forall l. SynTCType l -> Maybe Ident
typeName   :: Maybe AST.Ident,
                             forall l. SynTCType l -> Type l
definedType :: Type l,
                             forall l. SynTCType l -> Maybe Ident
pointerTarget :: Maybe AST.Ident}
                   deriving (forall x. SynTCType l -> Rep (SynTCType l) x)
-> (forall x. Rep (SynTCType l) x -> SynTCType l)
-> Generic (SynTCType l)
forall x. Rep (SynTCType l) x -> SynTCType l
forall x. SynTCType l -> Rep (SynTCType l) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall l x. Rep (SynTCType l) x -> SynTCType l
forall l x. SynTCType l -> Rep (SynTCType l) x
$cfrom :: forall l x. SynTCType l -> Rep (SynTCType l) x
from :: forall x. SynTCType l -> Rep (SynTCType l) x
$cto :: forall l x. Rep (SynTCType l) x -> SynTCType l
to :: forall x. Rep (SynTCType l) x -> SynTCType l
Generic

data SynTCFields l = SynTCFields{forall l. SynTCFields l -> Folded [Error () l]
errors :: Folded [Error () l],
                                 forall l. SynTCFields l -> Map Ident (Type l)
fieldEnv :: Map AST.Ident (Type l)}
                     deriving (forall x. SynTCFields l -> Rep (SynTCFields l) x)
-> (forall x. Rep (SynTCFields l) x -> SynTCFields l)
-> Generic (SynTCFields l)
forall x. Rep (SynTCFields l) x -> SynTCFields l
forall x. SynTCFields l -> Rep (SynTCFields l) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall l x. Rep (SynTCFields l) x -> SynTCFields l
forall l x. SynTCFields l -> Rep (SynTCFields l) x
$cfrom :: forall l x. SynTCFields l -> Rep (SynTCFields l) x
from :: forall x. SynTCFields l -> Rep (SynTCFields l) x
$cto :: forall l x. Rep (SynTCFields l) x -> SynTCFields l
to :: forall x. Rep (SynTCFields l) x -> SynTCFields l
Generic

data SynTCHead l = SynTCHead{forall l. SynTCHead l -> Folded [Error () l]
errors :: Folded [Error () l],
                             forall l. SynTCHead l -> Environment l
insideEnv :: Environment l,
                             forall l. SynTCHead l -> Environment l
outsideEnv :: Environment l}
                   deriving (forall x. SynTCHead l -> Rep (SynTCHead l) x)
-> (forall x. Rep (SynTCHead l) x -> SynTCHead l)
-> Generic (SynTCHead l)
forall x. Rep (SynTCHead l) x -> SynTCHead l
forall x. SynTCHead l -> Rep (SynTCHead l) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall l x. Rep (SynTCHead l) x -> SynTCHead l
forall l x. SynTCHead l -> Rep (SynTCHead l) x
$cfrom :: forall l x. SynTCHead l -> Rep (SynTCHead l) x
from :: forall x. SynTCHead l -> Rep (SynTCHead l) x
$cto :: forall l x. Rep (SynTCHead l) x -> SynTCHead l
to :: forall x. Rep (SynTCHead l) x -> SynTCHead l
Generic

data SynTCSig l = SynTCSig{forall l. SynTCSig l -> Folded [Error () l]
errors :: Folded [Error () l],
                           forall l. SynTCSig l -> Environment l
signatureEnv :: Environment l,
                           forall l. SynTCSig l -> Type l
signatureType :: Type l}
                  deriving (forall x. SynTCSig l -> Rep (SynTCSig l) x)
-> (forall x. Rep (SynTCSig l) x -> SynTCSig l)
-> Generic (SynTCSig l)
forall x. Rep (SynTCSig l) x -> SynTCSig l
forall x. SynTCSig l -> Rep (SynTCSig l) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall l x. Rep (SynTCSig l) x -> SynTCSig l
forall l x. SynTCSig l -> Rep (SynTCSig l) x
$cfrom :: forall l x. SynTCSig l -> Rep (SynTCSig l) x
from :: forall x. SynTCSig l -> Rep (SynTCSig l) x
$cto :: forall l x. Rep (SynTCSig l) x -> SynTCSig l
to :: forall x. Rep (SynTCSig l) x -> SynTCSig l
Generic

data SynTCSec l = SynTCSec{forall l. SynTCSec l -> Folded [Error () l]
errors :: Folded [Error () l],
                           forall l. SynTCSec l -> Environment l
sectionEnv :: Environment l,
                           forall l. SynTCSec l -> [(Bool, Type l)]
sectionParameters :: [(Bool, Type l)]}
                  deriving (forall x. SynTCSec l -> Rep (SynTCSec l) x)
-> (forall x. Rep (SynTCSec l) x -> SynTCSec l)
-> Generic (SynTCSec l)
forall x. Rep (SynTCSec l) x -> SynTCSec l
forall x. SynTCSec l -> Rep (SynTCSec l) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall l x. Rep (SynTCSec l) x -> SynTCSec l
forall l x. SynTCSec l -> Rep (SynTCSec l) x
$cfrom :: forall l x. SynTCSec l -> Rep (SynTCSec l) x
from :: forall x. SynTCSec l -> Rep (SynTCSec l) x
$cto :: forall l x. Rep (SynTCSec l) x -> SynTCSec l
to :: forall x. Rep (SynTCSec l) x -> SynTCSec l
Generic

data SynTCDes l = SynTCDes{forall l. SynTCDes l -> Folded [Error () l]
errors :: Folded [Error () l],
                           forall l. SynTCDes l -> Maybe (Maybe Ident, Ident)
designatorName   :: Maybe (Maybe Abstract.Ident, Abstract.Ident),
                           forall l. SynTCDes l -> Type l
designatorType :: Type l}
                  deriving (forall x. SynTCDes l -> Rep (SynTCDes l) x)
-> (forall x. Rep (SynTCDes l) x -> SynTCDes l)
-> Generic (SynTCDes l)
forall x. Rep (SynTCDes l) x -> SynTCDes l
forall x. SynTCDes l -> Rep (SynTCDes l) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall l x. Rep (SynTCDes l) x -> SynTCDes l
forall l x. SynTCDes l -> Rep (SynTCDes l) x
$cfrom :: forall l x. SynTCDes l -> Rep (SynTCDes l) x
from :: forall x. SynTCDes l -> Rep (SynTCDes l) x
$cto :: forall l x. Rep (SynTCDes l) x -> SynTCDes l
to :: forall x. Rep (SynTCDes l) x -> SynTCDes l
Generic

data SynTCExp l = SynTCExp{forall l. SynTCExp l -> Folded [Error () l]
errors :: Folded [Error () l],
                           forall l. SynTCExp l -> Type l
inferredType :: Type l}
                  deriving (forall x. SynTCExp l -> Rep (SynTCExp l) x)
-> (forall x. Rep (SynTCExp l) x -> SynTCExp l)
-> Generic (SynTCExp l)
forall x. Rep (SynTCExp l) x -> SynTCExp l
forall x. SynTCExp l -> Rep (SynTCExp l) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall l x. Rep (SynTCExp l) x -> SynTCExp l
forall l x. SynTCExp l -> Rep (SynTCExp l) x
$cfrom :: forall l x. SynTCExp l -> Rep (SynTCExp l) x
from :: forall x. SynTCExp l -> Rep (SynTCExp l) x
$cto :: forall l x. Rep (SynTCExp l) x -> SynTCExp l
to :: forall x. Rep (SynTCExp l) x -> SynTCExp l
Generic

-- * Modules instances, TH candidates
instance (Transformation.Transformation t, Functor (Transformation.Domain t), Deep.Functor t (AST.Module l l),
          Transformation.At t (AST.Module l l (Transformation.Codomain t) (Transformation.Codomain t))) =>
         Deep.Functor t (Modules l) where
   t
t <$> :: t
-> Modules l (Domain t) (Domain t)
-> Modules l (Codomain t) (Codomain t)
<$> ~(Modules Map Ident (Domain t (Module l l (Domain t) (Domain t)))
ms) = Map Ident (Codomain t (Module l l (Codomain t) (Codomain t)))
-> Modules l (Codomain t) (Codomain t)
forall l (f' :: * -> *) (f :: * -> *).
Map Ident (f (Module l l f' f')) -> Modules l f' f
Modules (Domain t (Module l l (Domain t) (Domain t))
-> Codomain t (Module l l (Codomain t) (Codomain t))
mapModule (Domain t (Module l l (Domain t) (Domain t))
 -> Codomain t (Module l l (Codomain t) (Codomain t)))
-> Map Ident (Domain t (Module l l (Domain t) (Domain t)))
-> Map Ident (Codomain t (Module l l (Codomain t) (Codomain t)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Ident (Domain t (Module l l (Domain t) (Domain t)))
ms)
      where mapModule :: Domain t (Module l l (Domain t) (Domain t))
-> Codomain t (Module l l (Codomain t) (Codomain t))
mapModule Domain t (Module l l (Domain t) (Domain t))
m = t
t t
-> Domain t (Module l l (Codomain t) (Codomain t))
-> Codomain t (Module l l (Codomain t) (Codomain t))
forall t x. At t x => t -> Domain t x -> Codomain t x
Transformation.$ ((t
t t
-> Module l l (Domain t) (Domain t)
-> Module l l (Codomain t) (Codomain t)
forall t (g :: (* -> *) -> (* -> *) -> *).
Functor t g =>
t -> g (Domain t) (Domain t) -> g (Codomain t) (Codomain t)
Deep.<$>) (Module l l (Domain t) (Domain t)
 -> Module l l (Codomain t) (Codomain t))
-> Domain t (Module l l (Domain t) (Domain t))
-> Domain t (Module l l (Codomain t) (Codomain t))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Domain t (Module l l (Domain t) (Domain t))
m)
instance (Transformation.Transformation t, Functor (Transformation.Domain t),
          Transformation.At t (AST.Module l l f f)) =>
         Shallow.Functor t (Modules l f) where
   t
t <$> :: t -> Modules l f (Domain t) -> Modules l f (Codomain t)
<$> ~(Modules Map Ident (Domain t (Module l l f f))
ms) = Map Ident (Codomain t (Module l l f f)) -> Modules l f (Codomain t)
forall l (f' :: * -> *) (f :: * -> *).
Map Ident (f (Module l l f' f')) -> Modules l f' f
Modules ((t
t t -> Domain t (Module l l f f) -> Codomain t (Module l l f f)
forall t x. At t x => t -> Domain t x -> Codomain t x
Transformation.$) (Domain t (Module l l f f) -> Codomain t (Module l l f f))
-> Map Ident (Domain t (Module l l f f))
-> Map Ident (Codomain t (Module l l f f))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Ident (Domain t (Module l l f f))
ms)
instance (Transformation.Transformation t, Functor (Transformation.Domain t), Shallow.Foldable t (AST.Module l l f),
          Transformation.At t (AST.Module l l f f)) =>
         Shallow.Foldable t (Modules l f) where
   foldMap :: forall m.
(Codomain t ~ Const m, Monoid m) =>
t -> Modules l f (Domain t) -> m
foldMap t
t ~(Modules Map Ident (Domain t (Module l l f f))
ms) = Const m (Module l l f f) -> m
forall {k} a (b :: k). Const a b -> a
getConst ((Domain t (Module l l f f) -> Const m (Module l l f f))
-> Map Ident (Domain t (Module l l f f))
-> Const m (Module l l f f)
forall m a. Monoid m => (a -> m) -> Map Ident a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (t
t t -> Domain t (Module l l f f) -> Codomain t (Module l l f f)
forall t x. At t x => t -> Domain t x -> Codomain t x
Transformation.$) Map Ident (Domain t (Module l l f f))
ms)

instance Rank2.Functor (Modules l f') where
   forall a. p a -> q a
f <$> :: forall (p :: * -> *) (q :: * -> *).
(forall a. p a -> q a) -> Modules l f' p -> Modules l f' q
<$> ~(Modules Map Ident (p (Module l l f' f'))
ms) = Map Ident (q (Module l l f' f')) -> Modules l f' q
forall l (f' :: * -> *) (f :: * -> *).
Map Ident (f (Module l l f' f')) -> Modules l f' f
Modules (p (Module l l f' f') -> q (Module l l f' f')
forall a. p a -> q a
f (p (Module l l f' f') -> q (Module l l f' f'))
-> Map Ident (p (Module l l f' f'))
-> Map Ident (q (Module l l f' f'))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Ident (p (Module l l f' f'))
ms)
instance Rank2.Foldable (Modules l f) where
   foldMap :: forall m (p :: * -> *).
Monoid m =>
(forall a. p a -> m) -> Modules l f p -> m
foldMap forall a. p a -> m
f ~(Modules Map Ident (p (Module l l f f))
ms) = (p (Module l l f f) -> m) -> Map Ident (p (Module l l f f)) -> m
forall m a. Monoid m => (a -> m) -> Map Ident a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap p (Module l l f f) -> m
forall a. p a -> m
f Map Ident (p (Module l l f f))
ms
instance Rank2.Apply (Modules l f') where
   ~(Modules Map Ident ((~>) p q (Module l l f' f'))
fs) <*> :: forall (p :: * -> *) (q :: * -> *).
Modules l f' (p ~> q) -> Modules l f' p -> Modules l f' q
<*> ~(Modules Map Ident (p (Module l l f' f'))
ms) = Map Ident (q (Module l l f' f')) -> Modules l f' q
forall l (f' :: * -> *) (f :: * -> *).
Map Ident (f (Module l l f' f')) -> Modules l f' f
Modules (((~>) p q (Module l l f' f')
 -> p (Module l l f' f') -> q (Module l l f' f'))
-> Map Ident ((~>) p q (Module l l f' f'))
-> Map Ident (p (Module l l f' f'))
-> Map Ident (q (Module l l f' f'))
forall k a b c.
Ord k =>
(a -> b -> c) -> Map k a -> Map k b -> Map k c
Map.intersectionWith (~>) p q (Module l l f' f')
-> p (Module l l f' f') -> q (Module l l f' f')
forall {k} (p :: k -> *) (q :: k -> *) (a :: k).
Arrow p q a -> p a -> q a
Rank2.apply Map Ident ((~>) p q (Module l l f' f'))
fs Map Ident (p (Module l l f' f'))
ms)

-- * Boring attribute types
type instance Atts (Inherited TypeCheck) (Modules l _ _) = InhTCRoot l
type instance Atts (Synthesized TypeCheck) (Modules l _ _) = SynTCMods l
type instance Atts (Inherited TypeCheck) (AST.Module l l _ _) = InhTC l
type instance Atts (Synthesized TypeCheck) (AST.Module l l _ _) = SynTCMod l
type instance Atts (Inherited TypeCheck) (AST.Declaration l l _ _) = InhTCDecl l
type instance Atts (Synthesized TypeCheck) (AST.Declaration l l _ _) = SynTCMod l
type instance Atts (Inherited TypeCheck) (AST.ProcedureHeading l l _ _) = InhTCDecl l
type instance Atts (Synthesized TypeCheck) (AST.ProcedureHeading l l _ _) = SynTCHead l
type instance Atts (Inherited TypeCheck) (AST.Block l l _ _) = InhTC l
type instance Atts (Synthesized TypeCheck) (AST.Block l l _ _) = SynTCMod l
type instance Atts (Inherited TypeCheck) (AST.FormalParameters l l _ _) = InhTC l
type instance Atts (Synthesized TypeCheck) (AST.FormalParameters l l _ _) = SynTCSig l
type instance Atts (Inherited TypeCheck) (AST.FPSection l l _ _) = InhTC l
type instance Atts (Synthesized TypeCheck) (AST.FPSection l l _ _) = SynTCSec l
type instance Atts (Inherited TypeCheck) (AST.Type l l _ _) = InhTC l
type instance Atts (Synthesized TypeCheck) (AST.Type l l _ _) = SynTCType l
type instance Atts (Inherited TypeCheck) (AST.FieldList l l _ _) = InhTC l
type instance Atts (Synthesized TypeCheck) (AST.FieldList l l _ _) = SynTCFields l
type instance Atts (Inherited TypeCheck) (AST.StatementSequence l l _ _) = InhTC l
type instance Atts (Synthesized TypeCheck) (AST.StatementSequence l l _ _) = SynTC l
type instance Atts (Inherited TypeCheck) (AST.Expression l l _ _) = InhTC l
type instance Atts (Synthesized TypeCheck) (AST.Expression l l _ _) = SynTCExp l
type instance Atts (Inherited TypeCheck) (AST.Element l l _ _) = InhTC l
type instance Atts (Synthesized TypeCheck) (AST.Element l l _ _) = SynTCExp l
type instance Atts (Inherited TypeCheck) (AST.Value l l _ _) = InhTC l
type instance Atts (Synthesized TypeCheck) (AST.Value l l _ _) = SynTCExp l
type instance Atts (Inherited TypeCheck) (AST.Designator l l _ _) = InhTC l
type instance Atts (Synthesized TypeCheck) (AST.Designator l l _ _) = SynTCDes l
type instance Atts (Inherited TypeCheck) (AST.Statement l l _ _) = InhTC l
type instance Atts (Synthesized TypeCheck) (AST.Statement l l _ _) = SynTC l
type instance Atts (Inherited TypeCheck) (AST.ConditionalBranch l l _ _) = InhTC l
type instance Atts (Synthesized TypeCheck) (AST.ConditionalBranch l l _ _) = SynTC l
type instance Atts (Inherited TypeCheck) (AST.Case l l _ _) = InhTCExp l
type instance Atts (Synthesized TypeCheck) (AST.Case l l _ _) = SynTC l
type instance Atts (Inherited TypeCheck) (AST.CaseLabels l l _ _) = InhTCExp l
type instance Atts (Synthesized TypeCheck) (AST.CaseLabels l l _ _) = SynTC l
type instance Atts (Inherited TypeCheck) (AST.WithAlternative l l _ _) = InhTC l
type instance Atts (Synthesized TypeCheck) (AST.WithAlternative l l _ _) = SynTC l

-- * Rules

instance Ord (Abstract.QualIdent l) => Bequether (Auto TypeCheck) (Modules l) Sem Placed where
   bequest :: forall (sem :: * -> *).
(sem ~ Semantics (Auto TypeCheck)) =>
Auto TypeCheck
-> Placed
     (Modules
        l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts (Inherited (Auto TypeCheck)) (Modules l sem sem)
-> Modules l sem (Synthesized (Auto TypeCheck))
-> Modules l sem (Inherited (Auto TypeCheck))
bequest Auto TypeCheck
_ (LexicalPosition
_, Modules Map
  Ident
  (Sem
     (Module
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
self) Atts (Inherited (Auto TypeCheck)) (Modules l sem sem)
inheritance (Modules Map Ident (Synthesized (Auto TypeCheck) (Module l l sem sem))
ms) =
     Map Ident (Inherited (Auto TypeCheck) (Module l l sem sem))
-> Modules l sem (Inherited (Auto TypeCheck))
forall l (f' :: * -> *) (f :: * -> *).
Map Ident (f (Module l l f' f')) -> Modules l f' f
Modules ((Ident
 -> Sem
      (Module
         l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
 -> Inherited (Auto TypeCheck) (Module l l sem sem))
-> Map
     Ident
     (Sem
        (Module
           l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
-> Map Ident (Inherited (Auto TypeCheck) (Module l l sem sem))
forall k a b. (k -> a -> b) -> Map k a -> Map k b
Map.mapWithKey Ident
-> Sem
     (Module
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Inherited (Auto TypeCheck) (Module l l sem sem)
moduleInheritance Map
  Ident
  (Sem
     (Module
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
self)
     where moduleInheritance :: Ident
-> Sem
     (Module
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Inherited (Auto TypeCheck) (Module l l sem sem)
moduleInheritance Ident
name Sem
  (Module
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
mod = Atts (Inherited (Auto TypeCheck)) (Module l l sem sem)
-> Inherited (Auto TypeCheck) (Module l l sem sem)
forall t a. Atts (Inherited t) a -> Inherited t a
Inherited InhTC{$sel:env:InhTC :: Map (QualIdent l) (Type l)
env= InhTCRoot l -> Map (QualIdent l) (Type l)
forall l. InhTCRoot l -> Environment l
rootEnv Atts (Inherited (Auto TypeCheck)) (Modules l sem sem)
InhTCRoot l
inheritance Map (QualIdent l) (Type l)
-> Map (QualIdent l) (Type l) -> Map (QualIdent l) (Type l)
forall a. Semigroup a => a -> a -> a
<> (Synthesized (Auto TypeCheck) (Module l l sem sem)
 -> Map (QualIdent l) (Type l))
-> Map Ident (Synthesized (Auto TypeCheck) (Module l l sem sem))
-> Map (QualIdent l) (Type l)
forall m a. Monoid m => (a -> m) -> Map Ident a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (SynTCMod l -> Map (QualIdent l) (Type l)
forall l. SynTCMod l -> Environment l
moduleEnv (SynTCMod l -> Map (QualIdent l) (Type l))
-> (Synthesized (Auto TypeCheck) (Module l l sem sem)
    -> SynTCMod l)
-> Synthesized (Auto TypeCheck) (Module l l sem sem)
-> Map (QualIdent l) (Type l)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Synthesized (Auto TypeCheck) (Module l l sem sem)
-> Atts (Synthesized (Auto TypeCheck)) (Module l l sem sem)
Synthesized (Auto TypeCheck) (Module l l sem sem) -> SynTCMod l
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn) Map Ident (Synthesized (Auto TypeCheck) (Module l l sem sem))
ms}
instance Ord (Abstract.QualIdent l) => Synthesizer (Auto TypeCheck) (Modules l) Sem Placed where
  synthesis :: forall (sem :: * -> *).
(sem ~ Semantics (Auto TypeCheck)) =>
Auto TypeCheck
-> Placed
     (Modules
        l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts (Inherited (Auto TypeCheck)) (Modules l sem sem)
-> Modules l sem (Synthesized (Auto TypeCheck))
-> Atts (Synthesized (Auto TypeCheck)) (Modules l sem sem)
synthesis Auto TypeCheck
_ Placed
  (Modules
     l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
_ Atts (Inherited (Auto TypeCheck)) (Modules l sem sem)
_ (Modules Map Ident (Synthesized (Auto TypeCheck) (Module l l sem sem))
ms) = SynTCMods{$sel:errors:SynTCMods :: Folded [Error Ident l]
errors= (Ident
 -> Synthesized (Auto TypeCheck) (Module l l sem sem)
 -> Folded [Error Ident l])
-> Map Ident (Synthesized (Auto TypeCheck) (Module l l sem sem))
-> Folded [Error Ident l]
forall m k a. Monoid m => (k -> a -> m) -> Map k a -> m
Map.foldMapWithKey Ident
-> Synthesized (Auto TypeCheck) (Module l l sem sem)
-> Folded [Error Ident l]
forall {t} {a} {l} {m}.
(Atts (Synthesized t) a ~ SynTCMod l) =>
m -> Synthesized t a -> Folded [Error m l]
moduleErrors Map Ident (Synthesized (Auto TypeCheck) (Module l l sem sem))
ms}
     where moduleErrors :: m -> Synthesized t a -> Folded [Error m l]
moduleErrors m
name (Synthesized SynTCMod{$sel:errors:SynTCMod :: forall l. SynTCMod l -> Folded [Error () l]
errors= Folded [Error () l]
errs}) =
              [Error m l] -> Folded [Error m l]
forall a. a -> Folded a
Folded [m -> LexicalPosition -> ErrorType l -> Error m l
forall m l. m -> LexicalPosition -> ErrorType l -> Error m l
Error m
name LexicalPosition
pos ErrorType l
t | Error () LexicalPosition
pos ErrorType l
t <- [Error () l]
errs]

instance (Abstract.Oberon l, Abstract.Nameable l, k ~ Abstract.QualIdent l, Ord k,
          Atts (Synthesized (Auto TypeCheck)) (Abstract.Block l l Sem Sem) ~ SynTCMod l) =>
         SynthesizedField "moduleEnv" (Map k (Type l)) (Auto TypeCheck) (AST.Module l l) Sem Placed where
   synthesizedField :: forall (sem :: * -> *).
(sem ~ Semantics (Auto TypeCheck)) =>
Proxy "moduleEnv"
-> Auto TypeCheck
-> Placed
     (Module
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts (Inherited (Auto TypeCheck)) (Module l l sem sem)
-> Module l l sem (Synthesized (Auto TypeCheck))
-> Map k (Type l)
synthesizedField Proxy "moduleEnv"
_ Auto TypeCheck
_ (LexicalPosition
pos, AST.Module Ident
moduleName [(Maybe Ident, Ident)]
imports Sem
  (Block
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
body) Atts (Inherited (Auto TypeCheck)) (Module l l sem sem)
_inheritance (AST.Module Ident
_ [(Maybe Ident, Ident)]
_ Synthesized (Auto TypeCheck) (Block l l sem sem)
body') = Map k (Type l)
exportedEnv
      where exportedEnv :: Map k (Type l)
exportedEnv = Type l -> Type l
exportNominal (Type l -> Type l) -> Map k (Type l) -> Map k (Type l)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QualIdent l -> k) -> Map (QualIdent l) (Type l) -> Map k (Type l)
forall k1 k2 a. (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeysMonotonic QualIdent l -> k
QualIdent l -> QualIdent l
export (SynTCMod l -> Map (QualIdent l) (Type l)
forall l. SynTCMod l -> Environment l
moduleEnv (SynTCMod l -> Map (QualIdent l) (Type l))
-> SynTCMod l -> Map (QualIdent l) (Type l)
forall a b. (a -> b) -> a -> b
$ Synthesized
  (Auto TypeCheck)
  (Block
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts
     (Synthesized (Auto TypeCheck))
     (Block
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto TypeCheck) (Block l l sem sem)
Synthesized
  (Auto TypeCheck)
  (Block
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
body')
            export :: QualIdent l -> QualIdent l
export QualIdent l
q
               | Just Ident
name <- QualIdent l -> Maybe Ident
forall l. Nameable l => QualIdent l -> Maybe Ident
Abstract.getNonQualIdentName QualIdent l
q = Ident -> Ident -> QualIdent l
forall l. Oberon l => Ident -> Ident -> QualIdent l
Abstract.qualIdent Ident
moduleName Ident
name
               | Bool
otherwise = QualIdent l
q
            exportNominal :: Type l -> Type l
exportNominal (NominalType QualIdent l
q (Just Type l
t))
               | Just Ident
name <- QualIdent l -> Maybe Ident
forall l. Nameable l => QualIdent l -> Maybe Ident
Abstract.getNonQualIdentName QualIdent l
q =
                 QualIdent l -> Maybe (Type l) -> Type l
forall l. QualIdent l -> Maybe (Type l) -> Type l
NominalType (Ident -> Ident -> QualIdent l
forall l. Oberon l => Ident -> Ident -> QualIdent l
Abstract.qualIdent Ident
moduleName Ident
name) (Type l -> Maybe (Type l)
forall a. a -> Maybe a
Just (Type l -> Maybe (Type l)) -> Type l -> Maybe (Type l)
forall a b. (a -> b) -> a -> b
$ Type l -> Type l
exportNominal' Type l
t)
            exportNominal Type l
t = Type l -> Type l
exportNominal' Type l
t
            exportNominal' :: Type l -> Type l
exportNominal' (RecordType [QualIdent l]
ancestry Map Ident (Type l)
fields) = [QualIdent l] -> Map Ident (Type l) -> Type l
forall l. [QualIdent l] -> Map Ident (Type l) -> Type l
RecordType (QualIdent l -> k
QualIdent l -> QualIdent l
export (QualIdent l -> k) -> [QualIdent l] -> [k]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [QualIdent l]
ancestry) (Type l -> Type l
exportNominal' (Type l -> Type l) -> Map Ident (Type l) -> Map Ident (Type l)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map Ident (Type l)
fields)
            exportNominal' (ProcedureType Bool
False [(Bool, Type l)]
parameters Maybe (Type l)
result) =
              Bool -> [(Bool, Type l)] -> Maybe (Type l) -> Type l
forall l. Bool -> [(Bool, Type l)] -> Maybe (Type l) -> Type l
ProcedureType Bool
False ((Type l -> Type l
exportNominal' (Type l -> Type l) -> (Bool, Type l) -> (Bool, Type l)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) ((Bool, Type l) -> (Bool, Type l))
-> [(Bool, Type l)] -> [(Bool, Type l)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Bool, Type l)]
parameters) (Type l -> Type l
exportNominal' (Type l -> Type l) -> Maybe (Type l) -> Maybe (Type l)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Type l)
result)
            exportNominal' (PointerType Type l
target) = Type l -> Type l
forall l. Type l -> Type l
PointerType (Type l -> Type l
exportNominal' Type l
target)
            exportNominal' (ArrayType [Int]
dimensions Type l
itemType) = [Int] -> Type l -> Type l
forall l. [Int] -> Type l -> Type l
ArrayType [Int]
dimensions (Type l -> Type l
exportNominal' Type l
itemType)
            exportNominal' (NominalType QualIdent l
q (Just Type l
t))
              | Just Ident
name <- QualIdent l -> Maybe Ident
forall l. Nameable l => QualIdent l -> Maybe Ident
Abstract.getNonQualIdentName QualIdent l
q =
                Type l -> Maybe (Type l) -> Type l
forall a. a -> Maybe a -> a
fromMaybe (QualIdent l -> Maybe (Type l) -> Type l
forall l. QualIdent l -> Maybe (Type l) -> Type l
NominalType (Ident -> Ident -> QualIdent l
forall l. Oberon l => Ident -> Ident -> QualIdent l
Abstract.qualIdent Ident
moduleName Ident
name) (Maybe (Type l) -> Type l) -> Maybe (Type l) -> Type l
forall a b. (a -> b) -> a -> b
$ Type l -> Maybe (Type l)
forall a. a -> Maybe a
Just (Type l -> Maybe (Type l)) -> Type l -> Maybe (Type l)
forall a b. (a -> b) -> a -> b
$ Type l -> Type l
exportNominal' Type l
t)
                          (k -> Map k (Type l) -> Maybe (Type l)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
QualIdent l
q Map k (Type l)
exportedEnv)
            exportNominal' Type l
t = Type l
t

instance (Abstract.Nameable l, Ord (Abstract.QualIdent l),
          Atts (Inherited (Auto TypeCheck)) (Abstract.Type l l Sem Sem) ~ InhTC l,
          Atts (Inherited (Auto TypeCheck)) (Abstract.ProcedureHeading l l Sem Sem) ~ InhTCDecl l,
          Atts (Inherited (Auto TypeCheck)) (Abstract.Block l l Sem Sem) ~ InhTC l,
          Atts (Synthesized (Auto TypeCheck)) (Abstract.ProcedureHeading l l Sem Sem) ~ SynTCHead l,
          Atts (Inherited (Auto TypeCheck)) (Abstract.FormalParameters l l Sem Sem) ~ InhTC l,
          Atts (Inherited (Auto TypeCheck)) (Abstract.ConstExpression l l Sem Sem) ~ InhTC l) =>
         Bequether (Auto TypeCheck) (AST.Declaration l l) Sem Placed where
   bequest :: forall (sem :: * -> *).
(sem ~ Semantics (Auto TypeCheck)) =>
Auto TypeCheck
-> Placed
     (Declaration
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts (Inherited (Auto TypeCheck)) (Declaration l l sem sem)
-> Declaration l l sem (Synthesized (Auto TypeCheck))
-> Declaration l l sem (Inherited (Auto TypeCheck))
bequest Auto TypeCheck
_ (LexicalPosition
pos, AST.ProcedureDeclaration{})
           inheritance :: Atts (Inherited (Auto TypeCheck)) (Declaration l l sem sem)
inheritance@InhTCDecl{$sel:env:InhTCDecl :: forall l. InhTCDecl l -> Environment l
env= Map (QualIdent l) (Type l)
declEnv} (AST.ProcedureDeclaration Synthesized (Auto TypeCheck) (ProcedureHeading l l sem sem)
heading Synthesized (Auto TypeCheck) (Block l l sem sem)
_body) =
      Inherited (Auto TypeCheck) (ProcedureHeading l l sem sem)
-> Inherited (Auto TypeCheck) (Block l l sem sem)
-> Declaration l l sem (Inherited (Auto TypeCheck))
forall λ l (f' :: * -> *) (f :: * -> *).
f (ProcedureHeading l l f' f')
-> f (Block l l f' f') -> Declaration λ l f' f
AST.ProcedureDeclaration (Atts
  (Inherited (Auto TypeCheck))
  (ProcedureHeading
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Inherited
     (Auto TypeCheck)
     (ProcedureHeading
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
forall t a. Atts (Inherited t) a -> Inherited t a
Inherited Atts
  (Inherited (Auto TypeCheck))
  (ProcedureHeading
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
Atts (Inherited (Auto TypeCheck)) (Declaration l l sem sem)
inheritance) (Atts
  (Inherited (Auto TypeCheck))
  (Block
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Inherited
     (Auto TypeCheck)
     (Block
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
forall t a. Atts (Inherited t) a -> Inherited t a
Inherited Atts
  (Inherited (Auto TypeCheck))
  (Block
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
InhTC l
bodyInherited)
      where bodyInherited :: InhTC l
bodyInherited = InhTC{$sel:env:InhTC :: Map (QualIdent l) (Type l)
env= SynTCHead l -> Map (QualIdent l) (Type l)
forall l. SynTCHead l -> Environment l
insideEnv (Synthesized
  (Auto TypeCheck)
  (ProcedureHeading
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts
     (Synthesized (Auto TypeCheck))
     (ProcedureHeading
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto TypeCheck) (ProcedureHeading l l sem sem)
Synthesized
  (Auto TypeCheck)
  (ProcedureHeading
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
heading) Map (QualIdent l) (Type l)
-> Map (QualIdent l) (Type l) -> Map (QualIdent l) (Type l)
forall k a. Ord k => Map k a -> Map k a -> Map k a
`Map.union` Map (QualIdent l) (Type l)
declEnv}
   bequest Auto TypeCheck
t Placed
  (Declaration
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
local Atts (Inherited (Auto TypeCheck)) (Declaration l l sem sem)
inheritance Declaration l l sem (Synthesized (Auto TypeCheck))
synthesized = Auto TypeCheck
-> (LexicalPosition, Declaration l l sem sem)
-> Atts (Inherited (Auto TypeCheck)) (Declaration l l sem sem)
-> Declaration l l sem (Synthesized (Auto TypeCheck))
-> Declaration l l sem (Inherited (Auto TypeCheck))
forall t (g :: (* -> *) -> (* -> *) -> *) (shallow :: * -> *)
       (sem :: * -> *).
(sem ~ Semantics t, Domain t ~ shallow, Revelation t,
 Functor
   (PassDown t sem (Atts (Inherited t) (g sem sem))) (g sem)) =>
t
-> shallow (g sem sem)
-> Atts (Inherited t) (g sem sem)
-> g sem (Synthesized t)
-> g sem (Inherited t)
AG.bequestDefault Auto TypeCheck
t (LexicalPosition, Declaration l l sem sem)
Placed
  (Declaration
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
local Atts (Inherited (Auto TypeCheck)) (Declaration l l sem sem)
inheritance Declaration l l sem (Synthesized (Auto TypeCheck))
synthesized

instance (Abstract.Nameable l, k ~ Abstract.QualIdent l, Ord k,
          Atts (Synthesized (Auto TypeCheck)) (Abstract.Declaration l l Sem Sem) ~ SynTCMod l,
          Atts (Synthesized (Auto TypeCheck)) (Abstract.Type l l Sem Sem) ~ SynTCType l,
          Atts (Synthesized (Auto TypeCheck)) (Abstract.FormalParameters l l Sem Sem) ~ SynTCSig l,
          Atts (Synthesized (Auto TypeCheck)) (Abstract.ProcedureHeading l l Sem Sem) ~ SynTCHead l,
          Atts (Synthesized (Auto TypeCheck)) (Abstract.ConstExpression l l Sem Sem) ~ SynTCExp l) =>
         SynthesizedField "moduleEnv" (Map k (Type l)) (Auto TypeCheck) (AST.Declaration l l) Sem Placed where
   synthesizedField :: forall (sem :: * -> *).
(sem ~ Semantics (Auto TypeCheck)) =>
Proxy "moduleEnv"
-> Auto TypeCheck
-> Placed
     (Declaration
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts (Inherited (Auto TypeCheck)) (Declaration l l sem sem)
-> Declaration l l sem (Synthesized (Auto TypeCheck))
-> Map k (Type l)
synthesizedField Proxy "moduleEnv"
_ Auto TypeCheck
_ (LexicalPosition
pos, AST.ConstantDeclaration IdentDef l
namedef Sem
  (ConstExpression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
_) Atts (Inherited (Auto TypeCheck)) (Declaration l l sem sem)
_ (AST.ConstantDeclaration IdentDef l
_ Synthesized (Auto TypeCheck) (ConstExpression l l sem sem)
expression) =
      k -> Type l -> Map k (Type l)
forall k a. k -> a -> Map k a
Map.singleton (Ident -> QualIdent l
forall l. Wirthy l => Ident -> QualIdent l
Abstract.nonQualIdent (Ident -> QualIdent l) -> Ident -> QualIdent l
forall a b. (a -> b) -> a -> b
$ IdentDef l -> Ident
forall l. Nameable l => IdentDef l -> Ident
Abstract.getIdentDefName IdentDef l
namedef) (SynTCExp l -> Type l
forall l. SynTCExp l -> Type l
inferredType (SynTCExp l -> Type l) -> SynTCExp l -> Type l
forall a b. (a -> b) -> a -> b
$ Synthesized
  (Auto TypeCheck)
  (ConstExpression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts
     (Synthesized (Auto TypeCheck))
     (ConstExpression
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto TypeCheck) (ConstExpression l l sem sem)
Synthesized
  (Auto TypeCheck)
  (ConstExpression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
expression)
   synthesizedField Proxy "moduleEnv"
_ Auto TypeCheck
_ (LexicalPosition
pos, AST.TypeDeclaration IdentDef l
namedef Sem
  (Type
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
_) Atts (Inherited (Auto TypeCheck)) (Declaration l l sem sem)
_ (AST.TypeDeclaration IdentDef l
_ Synthesized (Auto TypeCheck) (Type l l sem sem)
definition) =
      k -> Type l -> Map k (Type l)
forall k a. k -> a -> Map k a
Map.singleton k
QualIdent l
qname (Type l -> Type l
nominal (Type l -> Type l) -> Type l -> Type l
forall a b. (a -> b) -> a -> b
$ SynTCType l -> Type l
forall l. SynTCType l -> Type l
definedType (SynTCType l -> Type l) -> SynTCType l -> Type l
forall a b. (a -> b) -> a -> b
$ Synthesized
  (Auto TypeCheck)
  (Type
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts
     (Synthesized (Auto TypeCheck))
     (Type
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto TypeCheck) (Type l l sem sem)
Synthesized
  (Auto TypeCheck)
  (Type
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
definition)
      where nominal :: Type l -> Type l
nominal t :: Type l
t@BuiltinType{} = Type l
t
            nominal t :: Type l
t@NominalType{} = Type l
t
            nominal (PointerType t :: Type l
t@RecordType{}) =
               QualIdent l -> Maybe (Type l) -> Type l
forall l. QualIdent l -> Maybe (Type l) -> Type l
NominalType QualIdent l
qname (Type l -> Maybe (Type l)
forall a. a -> Maybe a
Just (Type l -> Maybe (Type l)) -> Type l -> Maybe (Type l)
forall a b. (a -> b) -> a -> b
$ Type l -> Type l
forall l. Type l -> Type l
PointerType (Type l -> Type l) -> Type l -> Type l
forall a b. (a -> b) -> a -> b
$ QualIdent l -> Maybe (Type l) -> Type l
forall l. QualIdent l -> Maybe (Type l) -> Type l
NominalType (Ident -> QualIdent l
forall l. Wirthy l => Ident -> QualIdent l
Abstract.nonQualIdent (Ident -> QualIdent l) -> Ident -> QualIdent l
forall a b. (a -> b) -> a -> b
$ Ident
nameIdent -> Ident -> Ident
forall a. Semigroup a => a -> a -> a
<>Ident
"^") (Type l -> Maybe (Type l)
forall a. a -> Maybe a
Just Type l
t))
            nominal Type l
t = QualIdent l -> Maybe (Type l) -> Type l
forall l. QualIdent l -> Maybe (Type l) -> Type l
NominalType QualIdent l
qname (Type l -> Maybe (Type l)
forall a. a -> Maybe a
Just Type l
t)
            qname :: QualIdent l
qname = Ident -> QualIdent l
forall l. Wirthy l => Ident -> QualIdent l
Abstract.nonQualIdent Ident
name
            name :: Ident
name = IdentDef l -> Ident
forall l. Nameable l => IdentDef l -> Ident
Abstract.getIdentDefName IdentDef l
namedef
   synthesizedField Proxy "moduleEnv"
_ Auto TypeCheck
_ (LexicalPosition
pos, AST.VariableDeclaration IdentList l
names Sem
  (Type
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
_) Atts (Inherited (Auto TypeCheck)) (Declaration l l sem sem)
_ (AST.VariableDeclaration IdentList l
_names Synthesized (Auto TypeCheck) (Type l l sem sem)
declaredType) =
      (IdentDef l -> Map k (Type l)) -> IdentList l -> Map k (Type l)
forall m a. Monoid m => (a -> m) -> NonEmpty a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap IdentDef l -> Map k (Type l)
binding IdentList l
names
      where binding :: IdentDef l -> Map k (Type l)
binding IdentDef l
name = k -> Type l -> Map k (Type l)
forall k a. k -> a -> Map k a
Map.singleton (Ident -> QualIdent l
forall l. Wirthy l => Ident -> QualIdent l
Abstract.nonQualIdent (Ident -> QualIdent l) -> Ident -> QualIdent l
forall a b. (a -> b) -> a -> b
$ IdentDef l -> Ident
forall l. Nameable l => IdentDef l -> Ident
Abstract.getIdentDefName IdentDef l
name)
                                         (SynTCType l -> Type l
forall l. SynTCType l -> Type l
definedType (SynTCType l -> Type l) -> SynTCType l -> Type l
forall a b. (a -> b) -> a -> b
$ Synthesized
  (Auto TypeCheck)
  (Type
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts
     (Synthesized (Auto TypeCheck))
     (Type
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto TypeCheck) (Type l l sem sem)
Synthesized
  (Auto TypeCheck)
  (Type
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
declaredType)
   synthesizedField Proxy "moduleEnv"
_ Auto TypeCheck
_ (LexicalPosition
pos, AST.ProcedureDeclaration{}) Atts (Inherited (Auto TypeCheck)) (Declaration l l sem sem)
_ (AST.ProcedureDeclaration Synthesized (Auto TypeCheck) (ProcedureHeading l l sem sem)
heading Synthesized (Auto TypeCheck) (Block l l sem sem)
body) =
      SynTCHead l -> Environment l
forall l. SynTCHead l -> Environment l
outsideEnv (Synthesized
  (Auto TypeCheck)
  (ProcedureHeading
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts
     (Synthesized (Auto TypeCheck))
     (ProcedureHeading
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto TypeCheck) (ProcedureHeading l l sem sem)
Synthesized
  (Auto TypeCheck)
  (ProcedureHeading
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
heading)
   synthesizedField Proxy "moduleEnv"
_ Auto TypeCheck
_ (LexicalPosition
pos, AST.ForwardDeclaration IdentDef l
namedef Maybe
  (Sem
     (FormalParameters
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
_sig) Atts (Inherited (Auto TypeCheck)) (Declaration l l sem sem)
_ (AST.ForwardDeclaration IdentDef l
_namedef Maybe (Synthesized (Auto TypeCheck) (FormalParameters l l sem sem))
sig) =
      (Synthesized
   (Auto TypeCheck)
   (FormalParameters
      l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
 -> Map k (Type l))
-> Maybe
     (Synthesized
        (Auto TypeCheck)
        (FormalParameters
           l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
-> Map k (Type l)
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (k -> Type l -> Map k (Type l)
forall k a. k -> a -> Map k a
Map.singleton (Ident -> QualIdent l
forall l. Wirthy l => Ident -> QualIdent l
Abstract.nonQualIdent (Ident -> QualIdent l) -> Ident -> QualIdent l
forall a b. (a -> b) -> a -> b
$ IdentDef l -> Ident
forall l. Nameable l => IdentDef l -> Ident
Abstract.getIdentDefName IdentDef l
namedef) (Type l -> Map k (Type l))
-> (Synthesized
      (Auto TypeCheck)
      (FormalParameters
         l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
    -> Type l)
-> Synthesized
     (Auto TypeCheck)
     (FormalParameters
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Map k (Type l)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SynTCSig l -> Type l
forall l. SynTCSig l -> Type l
signatureType (SynTCSig l -> Type l)
-> (Synthesized
      (Auto TypeCheck)
      (FormalParameters
         l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
    -> SynTCSig l)
-> Synthesized
     (Auto TypeCheck)
     (FormalParameters
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Type l
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Synthesized
  (Auto TypeCheck)
  (FormalParameters
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts
     (Synthesized (Auto TypeCheck))
     (FormalParameters
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
Synthesized
  (Auto TypeCheck)
  (FormalParameters
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> SynTCSig l
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn) Maybe (Synthesized (Auto TypeCheck) (FormalParameters l l sem sem))
Maybe
  (Synthesized
     (Auto TypeCheck)
     (FormalParameters
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
sig

instance (Abstract.Nameable l, k ~ Abstract.QualIdent l, Ord k,
          Atts (Synthesized (Auto TypeCheck)) (Abstract.Type l l Sem Sem) ~ SynTCType l) =>
         SynthesizedField "pointerTargets" (Folded (Map AST.Ident AST.Ident)) (Auto TypeCheck)
                                           (AST.Declaration l l) Sem Placed where
   synthesizedField :: forall (sem :: * -> *).
(sem ~ Semantics (Auto TypeCheck)) =>
Proxy "pointerTargets"
-> Auto TypeCheck
-> Placed
     (Declaration
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts (Inherited (Auto TypeCheck)) (Declaration l l sem sem)
-> Declaration l l sem (Synthesized (Auto TypeCheck))
-> Folded (Map Ident Ident)
synthesizedField Proxy "pointerTargets"
_ Auto TypeCheck
_ (LexicalPosition
pos, AST.TypeDeclaration IdentDef l
namedef Sem
  (Type
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
_) Atts (Inherited (Auto TypeCheck)) (Declaration l l sem sem)
_ (AST.TypeDeclaration IdentDef l
_ Synthesized (Auto TypeCheck) (Type l l sem sem)
definition) =
      (Ident -> Folded (Map Ident Ident))
-> Maybe Ident -> Folded (Map Ident Ident)
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Map Ident Ident -> Folded (Map Ident Ident)
forall a. a -> Folded a
Folded (Map Ident Ident -> Folded (Map Ident Ident))
-> (Ident -> Map Ident Ident) -> Ident -> Folded (Map Ident Ident)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ident -> Ident -> Map Ident Ident
forall k a. k -> a -> Map k a
Map.singleton Ident
name) (SynTCType l -> Maybe Ident
forall l. SynTCType l -> Maybe Ident
pointerTarget (SynTCType l -> Maybe Ident) -> SynTCType l -> Maybe Ident
forall a b. (a -> b) -> a -> b
$ Synthesized
  (Auto TypeCheck)
  (Type
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts
     (Synthesized (Auto TypeCheck))
     (Type
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto TypeCheck) (Type l l sem sem)
Synthesized
  (Auto TypeCheck)
  (Type
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
definition)
      where name :: Ident
name = IdentDef l -> Ident
forall l. Nameable l => IdentDef l -> Ident
Abstract.getIdentDefName IdentDef l
namedef
   synthesizedField Proxy "pointerTargets"
_ Auto TypeCheck
_ Placed
  (Declaration
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
_ Atts (Inherited (Auto TypeCheck)) (Declaration l l sem sem)
_ Declaration l l sem (Synthesized (Auto TypeCheck))
_ = Folded (Map Ident Ident)
forall a. Monoid a => a
mempty

instance (Abstract.Nameable l, Ord (Abstract.QualIdent l),
          Atts (Synthesized (Auto TypeCheck)) (Abstract.FormalParameters l l Sem Sem) ~ SynTCSig l) =>
         Synthesizer (Auto TypeCheck) (AST.ProcedureHeading l l) Sem Placed where
   synthesis :: forall (sem :: * -> *).
(sem ~ Semantics (Auto TypeCheck)) =>
Auto TypeCheck
-> Placed
     (ProcedureHeading
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts (Inherited (Auto TypeCheck)) (ProcedureHeading l l sem sem)
-> ProcedureHeading l l sem (Synthesized (Auto TypeCheck))
-> Atts
     (Synthesized (Auto TypeCheck)) (ProcedureHeading l l sem sem)
synthesis Auto TypeCheck
_ (LexicalPosition
pos, AST.ProcedureHeading Bool
indirect IdentDef l
namedef Maybe
  (Sem
     (FormalParameters
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
_sig) Atts (Inherited (Auto TypeCheck)) (ProcedureHeading l l sem sem)
_inheritance (AST.ProcedureHeading Bool
_indirect IdentDef l
_ Maybe (Synthesized (Auto TypeCheck) (FormalParameters l l sem sem))
sig) =
      SynTCHead{$sel:errors:SynTCHead :: Folded [Error () l]
errors= (Synthesized
   (Auto TypeCheck)
   (FormalParameters
      l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
 -> Folded [Error () l])
-> Maybe
     (Synthesized
        (Auto TypeCheck)
        (FormalParameters
           l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
-> Folded [Error () l]
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((.errors) (Atts
   (Synthesized TypeCheck)
   (FormalParameters
      l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
 -> Folded [Error () l])
-> (Synthesized
      (Auto TypeCheck)
      (FormalParameters
         l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
    -> Atts
         (Synthesized TypeCheck)
         (FormalParameters
            l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
-> Synthesized
     (Auto TypeCheck)
     (FormalParameters
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Folded [Error () l]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Synthesized
  (Auto TypeCheck)
  (FormalParameters
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts
     (Synthesized (Auto TypeCheck))
     (FormalParameters
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
Synthesized
  (Auto TypeCheck)
  (FormalParameters
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts
     (Synthesized TypeCheck)
     (FormalParameters
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn) Maybe (Synthesized (Auto TypeCheck) (FormalParameters l l sem sem))
Maybe
  (Synthesized
     (Auto TypeCheck)
     (FormalParameters
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
sig,
                $sel:outsideEnv:SynTCHead :: Map (QualIdent l) (Type l)
outsideEnv= QualIdent l -> Type l -> Map (QualIdent l) (Type l)
forall k a. k -> a -> Map k a
Map.singleton (Ident -> QualIdent l
forall l. Wirthy l => Ident -> QualIdent l
Abstract.nonQualIdent Ident
name) (Type l -> Map (QualIdent l) (Type l))
-> Type l -> Map (QualIdent l) (Type l)
forall a b. (a -> b) -> a -> b
$
                            Type l
-> (Synthesized
      (Auto TypeCheck)
      (FormalParameters
         l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
    -> Type l)
-> Maybe
     (Synthesized
        (Auto TypeCheck)
        (FormalParameters
           l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
-> Type l
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Bool -> [(Bool, Type l)] -> Maybe (Type l) -> Type l
forall l. Bool -> [(Bool, Type l)] -> Maybe (Type l) -> Type l
ProcedureType Bool
False [] Maybe (Type l)
forall a. Maybe a
Nothing) (SynTCSig l -> Type l
forall l. SynTCSig l -> Type l
signatureType (SynTCSig l -> Type l)
-> (Synthesized
      (Auto TypeCheck)
      (FormalParameters
         l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
    -> SynTCSig l)
-> Synthesized
     (Auto TypeCheck)
     (FormalParameters
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Type l
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Synthesized
  (Auto TypeCheck)
  (FormalParameters
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts
     (Synthesized (Auto TypeCheck))
     (FormalParameters
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
Synthesized
  (Auto TypeCheck)
  (FormalParameters
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> SynTCSig l
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn) Maybe (Synthesized (Auto TypeCheck) (FormalParameters l l sem sem))
Maybe
  (Synthesized
     (Auto TypeCheck)
     (FormalParameters
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
sig,
                $sel:insideEnv:SynTCHead :: Map (QualIdent l) (Type l)
insideEnv= (Synthesized
   (Auto TypeCheck)
   (FormalParameters
      l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
 -> Map (QualIdent l) (Type l))
-> Maybe
     (Synthesized
        (Auto TypeCheck)
        (FormalParameters
           l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
-> Map (QualIdent l) (Type l)
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (SynTCSig l -> Map (QualIdent l) (Type l)
forall l. SynTCSig l -> Environment l
signatureEnv (SynTCSig l -> Map (QualIdent l) (Type l))
-> (Synthesized
      (Auto TypeCheck)
      (FormalParameters
         l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
    -> SynTCSig l)
-> Synthesized
     (Auto TypeCheck)
     (FormalParameters
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Map (QualIdent l) (Type l)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Synthesized
  (Auto TypeCheck)
  (FormalParameters
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts
     (Synthesized (Auto TypeCheck))
     (FormalParameters
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
Synthesized
  (Auto TypeCheck)
  (FormalParameters
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> SynTCSig l
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn) Maybe (Synthesized (Auto TypeCheck) (FormalParameters l l sem sem))
Maybe
  (Synthesized
     (Auto TypeCheck)
     (FormalParameters
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
sig}
      where name :: Ident
name = IdentDef l -> Ident
forall l. Nameable l => IdentDef l -> Ident
Abstract.getIdentDefName IdentDef l
namedef
   synthesis Auto TypeCheck
_ (LexicalPosition
pos, AST.TypeBoundHeading Bool
var Ident
receiverName Ident
receiverType Bool
indirect IdentDef l
namedef Maybe
  (Sem
     (FormalParameters
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
_sig)
             InhTCDecl{Map (QualIdent l) (Type l)
$sel:env:InhTCDecl :: forall l. InhTCDecl l -> Environment l
env :: Map (QualIdent l) (Type l)
env, Map Ident Ident
$sel:pointerTargets:InhTCDecl :: forall l. InhTCDecl l -> Map Ident Ident
pointerTargets :: Map Ident Ident
pointerTargets} (AST.TypeBoundHeading Bool
_var Ident
_name Ident
_type Bool
_indirect IdentDef l
_ Maybe (Synthesized (Auto TypeCheck) (FormalParameters l l sem sem))
sig) =
      SynTCHead{$sel:errors:SynTCHead :: Folded [Error () l]
errors= Folded [Error () l]
receiverError Folded [Error () l] -> Folded [Error () l] -> Folded [Error () l]
forall a. Semigroup a => a -> a -> a
<> (Synthesized
   (Auto TypeCheck)
   (FormalParameters
      l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
 -> Folded [Error () l])
-> Maybe
     (Synthesized
        (Auto TypeCheck)
        (FormalParameters
           l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
-> Folded [Error () l]
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((.errors) (Atts
   (Synthesized TypeCheck)
   (FormalParameters
      l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
 -> Folded [Error () l])
-> (Synthesized
      (Auto TypeCheck)
      (FormalParameters
         l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
    -> Atts
         (Synthesized TypeCheck)
         (FormalParameters
            l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
-> Synthesized
     (Auto TypeCheck)
     (FormalParameters
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Folded [Error () l]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Synthesized
  (Auto TypeCheck)
  (FormalParameters
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts
     (Synthesized (Auto TypeCheck))
     (FormalParameters
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
Synthesized
  (Auto TypeCheck)
  (FormalParameters
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts
     (Synthesized TypeCheck)
     (FormalParameters
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn) Maybe (Synthesized (Auto TypeCheck) (FormalParameters l l sem sem))
Maybe
  (Synthesized
     (Auto TypeCheck)
     (FormalParameters
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
sig,
                $sel:outsideEnv:SynTCHead :: Map (QualIdent l) (Type l)
outsideEnv= case Ident -> Map Ident Ident -> Maybe Ident
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Ident
receiverType Map Ident Ident
pointerTargets
                            of Just Ident
targetName -> QualIdent l -> Type l -> Map (QualIdent l) (Type l)
forall k a. k -> a -> Map k a
Map.singleton (Ident -> QualIdent l
forall l. Wirthy l => Ident -> QualIdent l
Abstract.nonQualIdent Ident
targetName) Type l
methodType
                               Maybe Ident
Nothing -> QualIdent l -> Type l -> Map (QualIdent l) (Type l)
forall k a. k -> a -> Map k a
Map.singleton (Ident -> QualIdent l
forall l. Wirthy l => Ident -> QualIdent l
Abstract.nonQualIdent Ident
receiverType) Type l
methodType,
                $sel:insideEnv:SynTCHead :: Map (QualIdent l) (Type l)
insideEnv= Map (QualIdent l) (Type l)
receiverEnv Map (QualIdent l) (Type l)
-> Map (QualIdent l) (Type l) -> Map (QualIdent l) (Type l)
forall k a. Ord k => Map k a -> Map k a -> Map k a
`Map.union` (Synthesized
   (Auto TypeCheck)
   (FormalParameters
      l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
 -> Map (QualIdent l) (Type l))
-> Maybe
     (Synthesized
        (Auto TypeCheck)
        (FormalParameters
           l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
-> Map (QualIdent l) (Type l)
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (SynTCSig l -> Map (QualIdent l) (Type l)
forall l. SynTCSig l -> Environment l
signatureEnv (SynTCSig l -> Map (QualIdent l) (Type l))
-> (Synthesized
      (Auto TypeCheck)
      (FormalParameters
         l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
    -> SynTCSig l)
-> Synthesized
     (Auto TypeCheck)
     (FormalParameters
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Map (QualIdent l) (Type l)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Synthesized
  (Auto TypeCheck)
  (FormalParameters
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts
     (Synthesized (Auto TypeCheck))
     (FormalParameters
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
Synthesized
  (Auto TypeCheck)
  (FormalParameters
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> SynTCSig l
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn) Maybe (Synthesized (Auto TypeCheck) (FormalParameters l l sem sem))
Maybe
  (Synthesized
     (Auto TypeCheck)
     (FormalParameters
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
sig}
      where receiverEnv :: Map (QualIdent l) (Type l)
receiverEnv =
               (Type l -> Map (QualIdent l) (Type l))
-> Maybe (Type l) -> Map (QualIdent l) (Type l)
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (QualIdent l -> Type l -> Map (QualIdent l) (Type l)
forall k a. k -> a -> Map k a
Map.singleton (Ident -> QualIdent l
forall l. Wirthy l => Ident -> QualIdent l
Abstract.nonQualIdent Ident
receiverName) (Type l -> Map (QualIdent l) (Type l))
-> (Type l -> Type l) -> Type l -> Map (QualIdent l) (Type l)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type l -> Type l
forall l. Type l -> Type l
ReceiverType)
                       (QualIdent l -> Map (QualIdent l) (Type l) -> Maybe (Type l)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Ident -> QualIdent l
forall l. Wirthy l => Ident -> QualIdent l
Abstract.nonQualIdent Ident
receiverType) Map (QualIdent l) (Type l)
env)
            methodType :: Type l
methodType = QualIdent l -> Maybe (Type l) -> Type l
forall l. QualIdent l -> Maybe (Type l) -> Type l
NominalType (Ident -> QualIdent l
forall l. Wirthy l => Ident -> QualIdent l
Abstract.nonQualIdent Ident
"")
                                     (Type l -> Maybe (Type l)
forall a. a -> Maybe a
Just (Type l -> Maybe (Type l)) -> Type l -> Maybe (Type l)
forall a b. (a -> b) -> a -> b
$ [QualIdent l] -> Map Ident (Type l) -> Type l
forall l. [QualIdent l] -> Map Ident (Type l) -> Type l
RecordType [] (Map Ident (Type l) -> Type l) -> Map Ident (Type l) -> Type l
forall a b. (a -> b) -> a -> b
$ Ident -> Type l -> Map Ident (Type l)
forall k a. k -> a -> Map k a
Map.singleton Ident
name Type l
procedureType)
            name :: Ident
name = IdentDef l -> Ident
forall l. Nameable l => IdentDef l -> Ident
Abstract.getIdentDefName IdentDef l
namedef
            procedureType :: Type l
procedureType = Type l
-> (Synthesized
      (Auto TypeCheck)
      (FormalParameters
         l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
    -> Type l)
-> Maybe
     (Synthesized
        (Auto TypeCheck)
        (FormalParameters
           l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
-> Type l
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Bool -> [(Bool, Type l)] -> Maybe (Type l) -> Type l
forall l. Bool -> [(Bool, Type l)] -> Maybe (Type l) -> Type l
ProcedureType Bool
False [] Maybe (Type l)
forall a. Maybe a
Nothing) (SynTCSig l -> Type l
forall l. SynTCSig l -> Type l
signatureType (SynTCSig l -> Type l)
-> (Synthesized
      (Auto TypeCheck)
      (FormalParameters
         l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
    -> SynTCSig l)
-> Synthesized
     (Auto TypeCheck)
     (FormalParameters
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Type l
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Synthesized
  (Auto TypeCheck)
  (FormalParameters
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts
     (Synthesized (Auto TypeCheck))
     (FormalParameters
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
Synthesized
  (Auto TypeCheck)
  (FormalParameters
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> SynTCSig l
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn) Maybe (Synthesized (Auto TypeCheck) (FormalParameters l l sem sem))
Maybe
  (Synthesized
     (Auto TypeCheck)
     (FormalParameters
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
sig
            receiverError :: Folded [Error () l]
receiverError =
               case QualIdent l -> Map (QualIdent l) (Type l) -> Maybe (Type l)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (Ident -> QualIdent l
forall l. Wirthy l => Ident -> QualIdent l
Abstract.nonQualIdent Ident
receiverType) Map (QualIdent l) (Type l)
env
               of Maybe (Type l)
Nothing -> [Error () l] -> Folded [Error () l]
forall a. a -> Folded a
Folded [() -> LexicalPosition -> ErrorType l -> Error () l
forall m l. m -> LexicalPosition -> ErrorType l -> Error m l
Error () LexicalPosition
pos (QualIdent l -> ErrorType l
forall l. QualIdent l -> ErrorType l
UnknownName (QualIdent l -> ErrorType l) -> QualIdent l -> ErrorType l
forall a b. (a -> b) -> a -> b
$ Ident -> QualIdent l
forall l. Wirthy l => Ident -> QualIdent l
Abstract.nonQualIdent Ident
receiverType)]
                  Just Type l
t 
                     | RecordType{} <- Type l -> Type l
forall l. Type l -> Type l
ultimate Type l
t -> Folded [Error () l]
forall a. Monoid a => a
mempty
                     | PointerType Type l
t' <- Type l -> Type l
forall l. Type l -> Type l
ultimate Type l
t, RecordType{} <- Type l -> Type l
forall l. Type l -> Type l
ultimate Type l
t' -> Folded [Error () l]
forall a. Monoid a => a
mempty
                     | Bool
otherwise -> [Error () l] -> Folded [Error () l]
forall a. a -> Folded a
Folded [() -> LexicalPosition -> ErrorType l -> Error () l
forall m l. m -> LexicalPosition -> ErrorType l -> Error m l
Error () LexicalPosition
pos (Type l -> ErrorType l
forall l. Type l -> ErrorType l
NonRecordType Type l
t)]

instance (Abstract.Nameable l, Ord (Abstract.QualIdent l), Show (Abstract.QualIdent l),
          Atts (Synthesized (Auto TypeCheck)) (Abstract.Declaration l l Sem Sem) ~ SynTCMod l,
          Atts (Inherited (Auto TypeCheck)) (Abstract.Declaration l l Sem Sem) ~ InhTCDecl l,
          Atts (Inherited (Auto TypeCheck)) (Abstract.StatementSequence l l Sem Sem) ~ InhTC l) =>
         Bequether (Auto TypeCheck) (AST.Block l l) Sem Placed where
   bequest :: forall (sem :: * -> *).
(sem ~ Semantics (Auto TypeCheck)) =>
Auto TypeCheck
-> Placed
     (Block
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts (Inherited (Auto TypeCheck)) (Block l l sem sem)
-> Block l l sem (Synthesized (Auto TypeCheck))
-> Block l l sem (Inherited (Auto TypeCheck))
bequest Auto TypeCheck
_ (LexicalPosition
pos, AST.Block{}) inheritance :: Atts (Inherited (Auto TypeCheck)) (Block l l sem sem)
inheritance@InhTC{Map (QualIdent l) (Type l)
$sel:env:InhTC :: forall l. InhTC l -> Environment l
env :: Map (QualIdent l) (Type l)
env} (AST.Block ZipList (Synthesized (Auto TypeCheck) (Declaration l l sem sem))
declarations Maybe
  (Synthesized (Auto TypeCheck) (StatementSequence l l sem sem))
_statements) =
      ZipList (Inherited (Auto TypeCheck) (Declaration l l sem sem))
-> Maybe
     (Inherited (Auto TypeCheck) (StatementSequence l l sem sem))
-> Block l l sem (Inherited (Auto TypeCheck))
forall λ l (f' :: * -> *) (f :: * -> *).
ZipList (f (Declaration l l f' f'))
-> Maybe (f (StatementSequence l l f' f')) -> Block λ l f' f
AST.Block (Inherited (Auto TypeCheck) (Declaration l l sem sem)
-> ZipList (Inherited (Auto TypeCheck) (Declaration l l sem sem))
forall a. a -> ZipList a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inherited (Auto TypeCheck) (Declaration l l sem sem)
 -> ZipList (Inherited (Auto TypeCheck) (Declaration l l sem sem)))
-> Inherited (Auto TypeCheck) (Declaration l l sem sem)
-> ZipList (Inherited (Auto TypeCheck) (Declaration l l sem sem))
forall a b. (a -> b) -> a -> b
$ Atts
  (Inherited (Auto TypeCheck))
  (Declaration
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Inherited
     (Auto TypeCheck)
     (Declaration
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
forall t a. Atts (Inherited t) a -> Inherited t a
Inherited InhTCDecl{$sel:env:InhTCDecl :: Map (QualIdent l) (Type l)
env= Map (QualIdent l) (Type l)
localEnv,
                                            $sel:pointerTargets:InhTCDecl :: Map Ident Ident
pointerTargets= Folded (Map Ident Ident) -> Map Ident Ident
forall a. Folded a -> a
getFolded Folded (Map Ident Ident)
pointers})
                (Inherited (Auto TypeCheck) (StatementSequence l l sem sem)
-> Maybe
     (Inherited (Auto TypeCheck) (StatementSequence l l sem sem))
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inherited (Auto TypeCheck) (StatementSequence l l sem sem)
 -> Maybe
      (Inherited (Auto TypeCheck) (StatementSequence l l sem sem)))
-> Inherited (Auto TypeCheck) (StatementSequence l l sem sem)
-> Maybe
     (Inherited (Auto TypeCheck) (StatementSequence l l sem sem))
forall a b. (a -> b) -> a -> b
$ Atts
  (Inherited (Auto TypeCheck))
  (StatementSequence
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Inherited
     (Auto TypeCheck)
     (StatementSequence
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
forall t a. Atts (Inherited t) a -> Inherited t a
Inherited Atts
  (Inherited (Auto TypeCheck))
  (StatementSequence
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
InhTC l
localInheritance)
      where localInheritance :: InhTC l
            localInheritance :: InhTC l
localInheritance = Atts (Inherited (Auto TypeCheck)) (Block l l sem sem)
inheritance{env= localEnv}
            localEnv :: Map (QualIdent l) (Type l)
localEnv = ZipList
  (Synthesized
     (Auto TypeCheck)
     (Declaration
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
-> Map (QualIdent l) (Type l)
forall l.
(Nameable l, Ord (QualIdent l), Show (QualIdent l),
 Atts
   (Synthesized (Auto TypeCheck))
   (Declaration
      l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
 ~ SynTCMod l) =>
ZipList
  (Synthesized
     (Auto TypeCheck)
     (Declaration
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
-> Environment l
newEnv ZipList (Synthesized (Auto TypeCheck) (Declaration l l sem sem))
ZipList
  (Synthesized
     (Auto TypeCheck)
     (Declaration
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
declarations Map (QualIdent l) (Type l)
-> Map (QualIdent l) (Type l) -> Map (QualIdent l) (Type l)
forall a. Semigroup a => a -> a -> a
<> Map (QualIdent l) (Type l)
env
            pointers :: Folded (Map Ident Ident)
pointers= (Synthesized
   (Auto TypeCheck)
   (Declaration
      l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
 -> Folded (Map Ident Ident))
-> ZipList
     (Synthesized
        (Auto TypeCheck)
        (Declaration
           l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
-> Folded (Map Ident Ident)
forall m a. Monoid m => (a -> m) -> ZipList a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\Synthesized{syn :: forall t a. Synthesized t a -> Atts (Synthesized t) a
syn= SynTCMod{$sel:pointerTargets:SynTCMod :: forall l. SynTCMod l -> Folded (Map Ident Ident)
pointerTargets= Folded (Map Ident Ident)
ptrs}}-> Folded (Map Ident Ident)
ptrs) ZipList (Synthesized (Auto TypeCheck) (Declaration l l sem sem))
ZipList
  (Synthesized
     (Auto TypeCheck)
     (Declaration
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
declarations

instance (Abstract.Nameable l, k ~ Abstract.QualIdent l, Ord k, Show k,
          Atts (Synthesized (Auto TypeCheck)) (Abstract.Declaration l l Sem Sem) ~ SynTCMod l) =>
         SynthesizedField "moduleEnv" (Map k (Type l)) (Auto TypeCheck) (AST.Block l l) Sem Placed where
   synthesizedField :: forall (sem :: * -> *).
(sem ~ Semantics (Auto TypeCheck)) =>
Proxy "moduleEnv"
-> Auto TypeCheck
-> Placed
     (Block
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts (Inherited (Auto TypeCheck)) (Block l l sem sem)
-> Block l l sem (Synthesized (Auto TypeCheck))
-> Map k (Type l)
synthesizedField Proxy "moduleEnv"
_ Auto TypeCheck
_ (LexicalPosition
pos, AST.Block{}) Atts (Inherited (Auto TypeCheck)) (Block l l sem sem)
_inheritance (AST.Block ZipList (Synthesized (Auto TypeCheck) (Declaration l l sem sem))
declarations Maybe
  (Synthesized (Auto TypeCheck) (StatementSequence l l sem sem))
_statements) = ZipList
  (Synthesized
     (Auto TypeCheck)
     (Declaration
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
-> Environment l
forall l.
(Nameable l, Ord (QualIdent l), Show (QualIdent l),
 Atts
   (Synthesized (Auto TypeCheck))
   (Declaration
      l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
 ~ SynTCMod l) =>
ZipList
  (Synthesized
     (Auto TypeCheck)
     (Declaration
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
-> Environment l
newEnv ZipList (Synthesized (Auto TypeCheck) (Declaration l l sem sem))
ZipList
  (Synthesized
     (Auto TypeCheck)
     (Declaration
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
declarations

newEnv :: (Abstract.Nameable l, Ord (Abstract.QualIdent l), Show (Abstract.QualIdent l),
           Atts (Synthesized (Auto TypeCheck)) (Abstract.Declaration l l Sem Sem) ~ SynTCMod l) =>
          ZipList (Synthesized (Auto TypeCheck) (Abstract.Declaration l l Sem Sem)) -> Environment l
newEnv :: forall l.
(Nameable l, Ord (QualIdent l), Show (QualIdent l),
 Atts
   (Synthesized (Auto TypeCheck))
   (Declaration
      l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
 ~ SynTCMod l) =>
ZipList
  (Synthesized
     (Auto TypeCheck)
     (Declaration
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
-> Environment l
newEnv ZipList
  (Synthesized
     (Auto TypeCheck)
     (Declaration
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
declarations = (Type l -> Type l -> Type l)
-> ZipList (Map (QualIdent l) (Type l))
-> Map (QualIdent l) (Type l)
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
(a -> a -> a) -> f (Map k a) -> Map k a
Map.unionsWith Type l -> Type l -> Type l
forall {l}.
(Nameable l, Show (QualIdent l)) =>
Type l -> Type l -> Type l
mergeTypeBoundProcedures (SynTCMod l -> Map (QualIdent l) (Type l)
forall l. SynTCMod l -> Environment l
moduleEnv (SynTCMod l -> Map (QualIdent l) (Type l))
-> (Synthesized
      (Auto TypeCheck)
      (Declaration
         l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
    -> SynTCMod l)
-> Synthesized
     (Auto TypeCheck)
     (Declaration
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Map (QualIdent l) (Type l)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Synthesized
  (Auto TypeCheck)
  (Declaration
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts
     (Synthesized (Auto TypeCheck))
     (Declaration
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
Synthesized
  (Auto TypeCheck)
  (Declaration
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> SynTCMod l
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn (Synthesized
   (Auto TypeCheck)
   (Declaration
      l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
 -> Map (QualIdent l) (Type l))
-> ZipList
     (Synthesized
        (Auto TypeCheck)
        (Declaration
           l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
-> ZipList (Map (QualIdent l) (Type l))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ZipList
  (Synthesized
     (Auto TypeCheck)
     (Declaration
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
declarations)
   where mergeTypeBoundProcedures :: Type l -> Type l -> Type l
mergeTypeBoundProcedures (NominalType QualIdent l
q (Just Type l
t1)) Type l
t2
            | QualIdent l -> Maybe Ident
forall l. Nameable l => QualIdent l -> Maybe Ident
Abstract.getNonQualIdentName QualIdent l
q Maybe Ident -> Maybe Ident -> Bool
forall a. Eq a => a -> a -> Bool
== Ident -> Maybe Ident
forall a. a -> Maybe a
Just Ident
"" = Type l -> Type l -> Type l
mergeTypeBoundProcedures Type l
t1 Type l
t2
            | Bool
otherwise = QualIdent l -> Maybe (Type l) -> Type l
forall l. QualIdent l -> Maybe (Type l) -> Type l
NominalType QualIdent l
q (Type l -> Maybe (Type l)
forall a. a -> Maybe a
Just (Type l -> Maybe (Type l)) -> Type l -> Maybe (Type l)
forall a b. (a -> b) -> a -> b
$ Type l -> Type l -> Type l
mergeTypeBoundProcedures Type l
t1 Type l
t2)
         mergeTypeBoundProcedures Type l
t1 (NominalType QualIdent l
q (Just Type l
t2))
            | QualIdent l -> Maybe Ident
forall l. Nameable l => QualIdent l -> Maybe Ident
Abstract.getNonQualIdentName QualIdent l
q Maybe Ident -> Maybe Ident -> Bool
forall a. Eq a => a -> a -> Bool
== Ident -> Maybe Ident
forall a. a -> Maybe a
Just Ident
"" = Type l -> Type l -> Type l
mergeTypeBoundProcedures Type l
t1 Type l
t2
            | Bool
otherwise = QualIdent l -> Maybe (Type l) -> Type l
forall l. QualIdent l -> Maybe (Type l) -> Type l
NominalType QualIdent l
q (Type l -> Maybe (Type l)
forall a. a -> Maybe a
Just (Type l -> Maybe (Type l)) -> Type l -> Maybe (Type l)
forall a b. (a -> b) -> a -> b
$ Type l -> Type l -> Type l
mergeTypeBoundProcedures Type l
t1 Type l
t2)
         mergeTypeBoundProcedures (RecordType [QualIdent l]
ancestry1 Map Ident (Type l)
fields1) (RecordType [QualIdent l]
ancestry2 Map Ident (Type l)
fields2) =
            [QualIdent l] -> Map Ident (Type l) -> Type l
forall l. [QualIdent l] -> Map Ident (Type l) -> Type l
RecordType ([QualIdent l]
ancestry1 [QualIdent l] -> [QualIdent l] -> [QualIdent l]
forall a. Semigroup a => a -> a -> a
<> [QualIdent l]
ancestry2) (Map Ident (Type l)
fields1 Map Ident (Type l) -> Map Ident (Type l) -> Map Ident (Type l)
forall a. Semigroup a => a -> a -> a
<> Map Ident (Type l)
fields2)
         mergeTypeBoundProcedures (PointerType (RecordType [QualIdent l]
ancestry1 Map Ident (Type l)
fields1)) (RecordType [QualIdent l]
ancestry2 Map Ident (Type l)
fields2) =
            Type l -> Type l
forall l. Type l -> Type l
PointerType ([QualIdent l] -> Map Ident (Type l) -> Type l
forall l. [QualIdent l] -> Map Ident (Type l) -> Type l
RecordType ([QualIdent l]
ancestry1 [QualIdent l] -> [QualIdent l] -> [QualIdent l]
forall a. Semigroup a => a -> a -> a
<> [QualIdent l]
ancestry2) (Map Ident (Type l)
fields1 Map Ident (Type l) -> Map Ident (Type l) -> Map Ident (Type l)
forall a. Semigroup a => a -> a -> a
<> Map Ident (Type l)
fields2))
         mergeTypeBoundProcedures (RecordType [QualIdent l]
ancestry1 Map Ident (Type l)
fields1) (PointerType (RecordType [QualIdent l]
ancestry2 Map Ident (Type l)
fields2)) =
            Type l -> Type l
forall l. Type l -> Type l
PointerType ([QualIdent l] -> Map Ident (Type l) -> Type l
forall l. [QualIdent l] -> Map Ident (Type l) -> Type l
RecordType ([QualIdent l]
ancestry1 [QualIdent l] -> [QualIdent l] -> [QualIdent l]
forall a. Semigroup a => a -> a -> a
<> [QualIdent l]
ancestry2) (Map Ident (Type l)
fields1 Map Ident (Type l) -> Map Ident (Type l) -> Map Ident (Type l)
forall a. Semigroup a => a -> a -> a
<> Map Ident (Type l)
fields2))
         mergeTypeBoundProcedures (PointerType (NominalType QualIdent l
q (Just (RecordType [QualIdent l]
ancestry1 Map Ident (Type l)
fields1))))
                                  (RecordType [QualIdent l]
ancestry2 Map Ident (Type l)
fields2) =
            Type l -> Type l
forall l. Type l -> Type l
PointerType (QualIdent l -> Maybe (Type l) -> Type l
forall l. QualIdent l -> Maybe (Type l) -> Type l
NominalType QualIdent l
q (Maybe (Type l) -> Type l) -> Maybe (Type l) -> Type l
forall a b. (a -> b) -> a -> b
$ Type l -> Maybe (Type l)
forall a. a -> Maybe a
Just (Type l -> Maybe (Type l)) -> Type l -> Maybe (Type l)
forall a b. (a -> b) -> a -> b
$ [QualIdent l] -> Map Ident (Type l) -> Type l
forall l. [QualIdent l] -> Map Ident (Type l) -> Type l
RecordType ([QualIdent l]
ancestry1 [QualIdent l] -> [QualIdent l] -> [QualIdent l]
forall a. Semigroup a => a -> a -> a
<> [QualIdent l]
ancestry2) (Map Ident (Type l)
fields1 Map Ident (Type l) -> Map Ident (Type l) -> Map Ident (Type l)
forall a. Semigroup a => a -> a -> a
<> Map Ident (Type l)
fields2))
         mergeTypeBoundProcedures (RecordType [QualIdent l]
ancestry1 Map Ident (Type l)
fields1)
                                  (PointerType (NominalType QualIdent l
q (Just (RecordType [QualIdent l]
ancestry2 Map Ident (Type l)
fields2)))) =
            Type l -> Type l
forall l. Type l -> Type l
PointerType (QualIdent l -> Maybe (Type l) -> Type l
forall l. QualIdent l -> Maybe (Type l) -> Type l
NominalType QualIdent l
q (Maybe (Type l) -> Type l) -> Maybe (Type l) -> Type l
forall a b. (a -> b) -> a -> b
$ Type l -> Maybe (Type l)
forall a. a -> Maybe a
Just (Type l -> Maybe (Type l)) -> Type l -> Maybe (Type l)
forall a b. (a -> b) -> a -> b
$ [QualIdent l] -> Map Ident (Type l) -> Type l
forall l. [QualIdent l] -> Map Ident (Type l) -> Type l
RecordType ([QualIdent l]
ancestry1 [QualIdent l] -> [QualIdent l] -> [QualIdent l]
forall a. Semigroup a => a -> a -> a
<> [QualIdent l]
ancestry2) (Map Ident (Type l)
fields1 Map Ident (Type l) -> Map Ident (Type l) -> Map Ident (Type l)
forall a. Semigroup a => a -> a -> a
<> Map Ident (Type l)
fields2))
         mergeTypeBoundProcedures Type l
t1 Type l
t2 = String -> Type l
forall a. HasCallStack => String -> a
error (Int -> ShowS
forall a. Int -> [a] -> [a]
take Int
90 ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Type l -> String
forall a. Show a => a -> String
show Type l
t1)
            
instance (Ord (Abstract.QualIdent l),
          Atts (Synthesized (Auto TypeCheck)) (Abstract.FPSection l l Sem Sem) ~ SynTCSec l) =>
         Synthesizer (Auto TypeCheck) (AST.FormalParameters l l) Sem Placed where
   synthesis :: forall (sem :: * -> *).
(sem ~ Semantics (Auto TypeCheck)) =>
Auto TypeCheck
-> Placed
     (FormalParameters
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts (Inherited (Auto TypeCheck)) (FormalParameters l l sem sem)
-> FormalParameters l l sem (Synthesized (Auto TypeCheck))
-> Atts
     (Synthesized (Auto TypeCheck)) (FormalParameters l l sem sem)
synthesis Auto TypeCheck
_ (LexicalPosition
pos, AST.FormalParameters ZipList
  (Sem
     (FPSection
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
sections Maybe (QualIdent l)
returnType) InhTC{Map (QualIdent l) (Type l)
$sel:env:InhTC :: forall l. InhTC l -> Environment l
env :: Map (QualIdent l) (Type l)
env}
             (AST.FormalParameters ZipList (Synthesized (Auto TypeCheck) (FPSection l l sem sem))
sections' Maybe (QualIdent l)
_) =
      SynTCSig{$sel:errors:SynTCSig :: Folded [Error () l]
errors= (Synthesized
   (Auto TypeCheck)
   (FPSection
      l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
 -> Folded [Error () l])
-> ZipList
     (Synthesized
        (Auto TypeCheck)
        (FPSection
           l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
-> Folded [Error () l]
forall m a. Monoid m => (a -> m) -> ZipList a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((.errors) (Atts
   (Synthesized TypeCheck)
   (FPSection
      l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
 -> Folded [Error () l])
-> (Synthesized
      (Auto TypeCheck)
      (FPSection
         l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
    -> Atts
         (Synthesized TypeCheck)
         (FPSection
            l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
-> Synthesized
     (Auto TypeCheck)
     (FPSection
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Folded [Error () l]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Synthesized
  (Auto TypeCheck)
  (FPSection
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts
     (Synthesized (Auto TypeCheck))
     (FPSection
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
Synthesized
  (Auto TypeCheck)
  (FPSection
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts
     (Synthesized TypeCheck)
     (FPSection
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn) ZipList (Synthesized (Auto TypeCheck) (FPSection l l sem sem))
ZipList
  (Synthesized
     (Auto TypeCheck)
     (FPSection
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
sections' Folded [Error () l] -> Folded [Error () l] -> Folded [Error () l]
forall a. Semigroup a => a -> a -> a
<> (QualIdent l -> Folded [Error () l])
-> Maybe (QualIdent l) -> Folded [Error () l]
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap QualIdent l -> Folded [Error () l]
typeRefErrors Maybe (QualIdent l)
returnType,
               $sel:signatureType:SynTCSig :: Type l
signatureType= Bool -> [(Bool, Type l)] -> Maybe (Type l) -> Type l
forall l. Bool -> [(Bool, Type l)] -> Maybe (Type l) -> Type l
ProcedureType Bool
False ((Synthesized
   (Auto TypeCheck)
   (FPSection
      l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
 -> [(Bool, Type l)])
-> ZipList
     (Synthesized
        (Auto TypeCheck)
        (FPSection
           l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
-> [(Bool, Type l)]
forall m a. Monoid m => (a -> m) -> ZipList a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (SynTCSec l -> [(Bool, Type l)]
forall l. SynTCSec l -> [(Bool, Type l)]
sectionParameters (SynTCSec l -> [(Bool, Type l)])
-> (Synthesized
      (Auto TypeCheck)
      (FPSection
         l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
    -> SynTCSec l)
-> Synthesized
     (Auto TypeCheck)
     (FPSection
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> [(Bool, Type l)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Synthesized
  (Auto TypeCheck)
  (FPSection
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts
     (Synthesized (Auto TypeCheck))
     (FPSection
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
Synthesized
  (Auto TypeCheck)
  (FPSection
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> SynTCSec l
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn) ZipList (Synthesized (Auto TypeCheck) (FPSection l l sem sem))
ZipList
  (Synthesized
     (Auto TypeCheck)
     (FPSection
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
sections')
                              (Maybe (Type l) -> Type l) -> Maybe (Type l) -> Type l
forall a b. (a -> b) -> a -> b
$ Maybe (QualIdent l)
returnType Maybe (QualIdent l)
-> (QualIdent l -> Maybe (Type l)) -> Maybe (Type l)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (QualIdent l -> Map (QualIdent l) (Type l) -> Maybe (Type l)
forall k a. Ord k => k -> Map k a -> Maybe a
`Map.lookup` Map (QualIdent l) (Type l)
env),
               $sel:signatureEnv:SynTCSig :: Map (QualIdent l) (Type l)
signatureEnv= (Synthesized
   (Auto TypeCheck)
   (FPSection
      l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
 -> Map (QualIdent l) (Type l))
-> ZipList
     (Synthesized
        (Auto TypeCheck)
        (FPSection
           l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
-> Map (QualIdent l) (Type l)
forall m a. Monoid m => (a -> m) -> ZipList a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (SynTCSec l -> Map (QualIdent l) (Type l)
forall l. SynTCSec l -> Environment l
sectionEnv (SynTCSec l -> Map (QualIdent l) (Type l))
-> (Synthesized
      (Auto TypeCheck)
      (FPSection
         l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
    -> SynTCSec l)
-> Synthesized
     (Auto TypeCheck)
     (FPSection
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Map (QualIdent l) (Type l)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Synthesized
  (Auto TypeCheck)
  (FPSection
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts
     (Synthesized (Auto TypeCheck))
     (FPSection
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
Synthesized
  (Auto TypeCheck)
  (FPSection
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> SynTCSec l
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn) ZipList (Synthesized (Auto TypeCheck) (FPSection l l sem sem))
ZipList
  (Synthesized
     (Auto TypeCheck)
     (FPSection
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
sections'}
      where typeRefErrors :: QualIdent l -> Folded [Error () l]
typeRefErrors QualIdent l
q
               | QualIdent l -> Map (QualIdent l) (Type l) -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member QualIdent l
q Map (QualIdent l) (Type l)
env = Folded [Error () l]
forall a. Monoid a => a
mempty
               | Bool
otherwise = [Error () l] -> Folded [Error () l]
forall a. a -> Folded a
Folded [() -> LexicalPosition -> ErrorType l -> Error () l
forall m l. m -> LexicalPosition -> ErrorType l -> Error m l
Error () LexicalPosition
pos (QualIdent l -> ErrorType l
forall l. QualIdent l -> ErrorType l
UnknownName QualIdent l
q)]

instance (Abstract.Wirthy l, Ord (Abstract.QualIdent l),
          Atts (Synthesized (Auto TypeCheck)) (Abstract.Type l l Sem Sem) ~ SynTCType l) =>
         Synthesizer (Auto TypeCheck) (AST.FPSection l l) Sem Placed where
   synthesis :: forall (sem :: * -> *).
(sem ~ Semantics (Auto TypeCheck)) =>
Auto TypeCheck
-> Placed
     (FPSection
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts (Inherited (Auto TypeCheck)) (FPSection l l sem sem)
-> FPSection l l sem (Synthesized (Auto TypeCheck))
-> Atts (Synthesized (Auto TypeCheck)) (FPSection l l sem sem)
synthesis Auto TypeCheck
_ (LexicalPosition
pos, AST.FPSection Bool
var [Ident]
names Sem
  (Type
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
_typeDef) Atts (Inherited (Auto TypeCheck)) (FPSection l l sem sem)
_inheritance (AST.FPSection Bool
_var [Ident]
_names Synthesized (Auto TypeCheck) (Type l l sem sem)
typeDef) =
      SynTCSec{$sel:errors:SynTCSec :: Folded [Error () l]
errors= (Synthesized
  (Auto TypeCheck)
  (Type
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts
     (Synthesized (Auto TypeCheck))
     (Type
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto TypeCheck) (Type l l sem sem)
Synthesized
  (Auto TypeCheck)
  (Type
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
typeDef).errors,
               $sel:sectionParameters:SynTCSec :: [(Bool, Type l)]
sectionParameters= (Bool
var, SynTCType l -> Type l
forall l. SynTCType l -> Type l
definedType (Synthesized
  (Auto TypeCheck)
  (Type
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts
     (Synthesized (Auto TypeCheck))
     (Type
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto TypeCheck) (Type l l sem sem)
Synthesized
  (Auto TypeCheck)
  (Type
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
typeDef)) (Bool, Type l) -> [Ident] -> [(Bool, Type l)]
forall a b. a -> [b] -> [a]
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [Ident]
names,
               $sel:sectionEnv:SynTCSec :: Environment l
sectionEnv= [(QualIdent l, Type l)] -> Environment l
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ((QualIdent l -> Type l -> (QualIdent l, Type l))
-> Type l -> QualIdent l -> (QualIdent l, Type l)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (,) (SynTCType l -> Type l
forall l. SynTCType l -> Type l
definedType (SynTCType l -> Type l) -> SynTCType l -> Type l
forall a b. (a -> b) -> a -> b
$ Synthesized
  (Auto TypeCheck)
  (Type
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts
     (Synthesized (Auto TypeCheck))
     (Type
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto TypeCheck) (Type l l sem sem)
Synthesized
  (Auto TypeCheck)
  (Type
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
typeDef) (QualIdent l -> (QualIdent l, Type l))
-> (Ident -> QualIdent l) -> Ident -> (QualIdent l, Type l)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ident -> QualIdent l
forall l. Wirthy l => Ident -> QualIdent l
Abstract.nonQualIdent (Ident -> (QualIdent l, Type l))
-> [Ident] -> [(QualIdent l, Type l)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Ident]
names)}

instance (Abstract.Nameable l, Ord (Abstract.QualIdent l),
          Atts (Synthesized (Auto TypeCheck)) (Abstract.FormalParameters l l Sem Sem) ~ SynTCSig l,
          Atts (Synthesized (Auto TypeCheck)) (Abstract.FieldList l l Sem Sem) ~ SynTCFields l,
          Atts (Synthesized (Auto TypeCheck)) (Abstract.Type l l Sem Sem) ~ SynTCType l,
          Atts (Synthesized (Auto TypeCheck)) (Abstract.ConstExpression l l Sem Sem) ~ SynTCExp l) =>
         Synthesizer (Auto TypeCheck) (AST.Type l l) Sem Placed where
   synthesis :: forall (sem :: * -> *).
(sem ~ Semantics (Auto TypeCheck)) =>
Auto TypeCheck
-> Placed
     (Type
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts (Inherited (Auto TypeCheck)) (Type l l sem sem)
-> Type l l sem (Synthesized (Auto TypeCheck))
-> Atts (Synthesized (Auto TypeCheck)) (Type l l sem sem)
synthesis Auto TypeCheck
_ (LexicalPosition
pos, AST.TypeReference QualIdent l
q) InhTC{Environment l
$sel:env:InhTC :: forall l. InhTC l -> Environment l
env :: Environment l
env} Type l l sem (Synthesized (Auto TypeCheck))
_ = 
      SynTCType{$sel:errors:SynTCType :: Folded [Error () l]
errors= if QualIdent l -> Environment l -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member QualIdent l
q Environment l
env then Folded [Error () l]
forall a. Monoid a => a
mempty else [Error () l] -> Folded [Error () l]
forall a. a -> Folded a
Folded [() -> LexicalPosition -> ErrorType l -> Error () l
forall m l. m -> LexicalPosition -> ErrorType l -> Error m l
Error () LexicalPosition
pos (QualIdent l -> ErrorType l
forall l. QualIdent l -> ErrorType l
UnknownName QualIdent l
q)],
                $sel:typeName:SynTCType :: Maybe Ident
typeName= QualIdent l -> Maybe Ident
forall l. Nameable l => QualIdent l -> Maybe Ident
Abstract.getNonQualIdentName QualIdent l
q,
                $sel:pointerTarget:SynTCType :: Maybe Ident
pointerTarget= Maybe Ident
forall a. Maybe a
Nothing,
                $sel:definedType:SynTCType :: Type l
definedType= Type l -> Maybe (Type l) -> Type l
forall a. a -> Maybe a -> a
fromMaybe Type l
forall l. Type l
UnknownType (QualIdent l -> Environment l -> Maybe (Type l)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup QualIdent l
q Environment l
env)}
   synthesis Auto TypeCheck
_ (LexicalPosition
pos, AST.ArrayType ZipList
  (Sem
     (ConstExpression
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
_dims Sem
  (Type
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
_itemType) InhTC{} (AST.ArrayType ZipList
  (Synthesized (Auto TypeCheck) (ConstExpression l l sem sem))
dimensions Synthesized (Auto TypeCheck) (Type l l sem sem)
itemType) =
      SynTCType{$sel:errors:SynTCType :: Folded [Error () l]
errors= (Synthesized
   (Auto TypeCheck)
   (ConstExpression
      l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
 -> Folded [Error () l])
-> ZipList
     (Synthesized
        (Auto TypeCheck)
        (ConstExpression
           l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
-> Folded [Error () l]
forall m a. Monoid m => (a -> m) -> ZipList a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((.errors) (Atts
   (Synthesized TypeCheck)
   (ConstExpression
      l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
 -> Folded [Error () l])
-> (Synthesized
      (Auto TypeCheck)
      (ConstExpression
         l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
    -> Atts
         (Synthesized TypeCheck)
         (ConstExpression
            l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
-> Synthesized
     (Auto TypeCheck)
     (ConstExpression
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Folded [Error () l]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Synthesized
  (Auto TypeCheck)
  (ConstExpression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts
     (Synthesized (Auto TypeCheck))
     (ConstExpression
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
Synthesized
  (Auto TypeCheck)
  (ConstExpression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts
     (Synthesized TypeCheck)
     (ConstExpression
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn) ZipList
  (Synthesized (Auto TypeCheck) (ConstExpression l l sem sem))
ZipList
  (Synthesized
     (Auto TypeCheck)
     (ConstExpression
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
dimensions
                        Folded [Error () l] -> Folded [Error () l] -> Folded [Error () l]
forall a. Semigroup a => a -> a -> a
<> (Synthesized
  (Auto TypeCheck)
  (Type
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts
     (Synthesized (Auto TypeCheck))
     (Type
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto TypeCheck) (Type l l sem sem)
Synthesized
  (Auto TypeCheck)
  (Type
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
itemType).errors
                        Folded [Error () l] -> Folded [Error () l] -> Folded [Error () l]
forall a. Semigroup a => a -> a -> a
<> (Synthesized
   (Auto TypeCheck)
   (ConstExpression
      l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
 -> Folded [Error () l])
-> ZipList
     (Synthesized
        (Auto TypeCheck)
        (ConstExpression
           l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
-> Folded [Error () l]
forall m a. Monoid m => (a -> m) -> ZipList a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (SynTCExp l -> Folded [Error () l]
expectInteger (SynTCExp l -> Folded [Error () l])
-> (Synthesized
      (Auto TypeCheck)
      (ConstExpression
         l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
    -> SynTCExp l)
-> Synthesized
     (Auto TypeCheck)
     (ConstExpression
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Folded [Error () l]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Synthesized
  (Auto TypeCheck)
  (ConstExpression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts
     (Synthesized (Auto TypeCheck))
     (ConstExpression
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
Synthesized
  (Auto TypeCheck)
  (ConstExpression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> SynTCExp l
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn) ZipList
  (Synthesized (Auto TypeCheck) (ConstExpression l l sem sem))
ZipList
  (Synthesized
     (Auto TypeCheck)
     (ConstExpression
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
dimensions,
                $sel:typeName:SynTCType :: Maybe Ident
typeName= Maybe Ident
forall a. Maybe a
Nothing,
                $sel:pointerTarget:SynTCType :: Maybe Ident
pointerTarget= Maybe Ident
forall a. Maybe a
Nothing,
                $sel:definedType:SynTCType :: Type l
definedType= [Int] -> Type l -> Type l
forall l. [Int] -> Type l -> Type l
ArrayType (SynTCExp l -> Int
forall {l}. SynTCExp l -> Int
integerValue (SynTCExp l -> Int)
-> (Synthesized
      (Auto TypeCheck)
      (ConstExpression
         l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
    -> SynTCExp l)
-> Synthesized
     (Auto TypeCheck)
     (ConstExpression
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Synthesized
  (Auto TypeCheck)
  (ConstExpression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts
     (Synthesized (Auto TypeCheck))
     (ConstExpression
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
Synthesized
  (Auto TypeCheck)
  (ConstExpression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> SynTCExp l
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn (Synthesized
   (Auto TypeCheck)
   (ConstExpression
      l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
 -> Int)
-> [Synthesized
      (Auto TypeCheck)
      (ConstExpression
         l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))]
-> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ZipList
  (Synthesized
     (Auto TypeCheck)
     (ConstExpression
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
-> [Synthesized
      (Auto TypeCheck)
      (ConstExpression
         l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))]
forall a. ZipList a -> [a]
getZipList ZipList
  (Synthesized (Auto TypeCheck) (ConstExpression l l sem sem))
ZipList
  (Synthesized
     (Auto TypeCheck)
     (ConstExpression
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
dimensions) (SynTCType l -> Type l
forall l. SynTCType l -> Type l
definedType (SynTCType l -> Type l) -> SynTCType l -> Type l
forall a b. (a -> b) -> a -> b
$ Synthesized
  (Auto TypeCheck)
  (Type
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts
     (Synthesized (Auto TypeCheck))
     (Type
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto TypeCheck) (Type l l sem sem)
Synthesized
  (Auto TypeCheck)
  (Type
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
itemType)}
     where expectInteger :: SynTCExp l -> Folded [Error () l]
expectInteger SynTCExp{$sel:inferredType:SynTCExp :: forall l. SynTCExp l -> Type l
inferredType= IntegerType{}} = Folded [Error () l]
forall a. Monoid a => a
mempty
           expectInteger SynTCExp{$sel:inferredType:SynTCExp :: forall l. SynTCExp l -> Type l
inferredType= Type l
t} = [Error () l] -> Folded [Error () l]
forall a. a -> Folded a
Folded [() -> LexicalPosition -> ErrorType l -> Error () l
forall m l. m -> LexicalPosition -> ErrorType l -> Error m l
Error () LexicalPosition
pos (Type l -> ErrorType l
forall l. Type l -> ErrorType l
NonIntegerType Type l
t)]
           integerValue :: SynTCExp l -> Int
integerValue SynTCExp{$sel:inferredType:SynTCExp :: forall l. SynTCExp l -> Type l
inferredType= IntegerType Int
n} = Int
n
           integerValue SynTCExp l
_ = Int
0
   synthesis Auto TypeCheck
_ (LexicalPosition
pos, AST.RecordType Maybe (QualIdent l)
base ZipList
  (Sem
     (FieldList
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
fields) InhTC{Environment l
$sel:env:InhTC :: forall l. InhTC l -> Environment l
env :: Environment l
env} (AST.RecordType Maybe (QualIdent l)
_base ZipList (Synthesized (Auto TypeCheck) (FieldList l l sem sem))
fields') =
      SynTCType{$sel:errors:SynTCType :: Folded [Error () l]
errors= (Folded [Error () l], Maybe (Type l)) -> Folded [Error () l]
forall a b. (a, b) -> a
fst (Folded [Error () l], Maybe (Type l))
baseRecord Folded [Error () l] -> Folded [Error () l] -> Folded [Error () l]
forall a. Semigroup a => a -> a -> a
<> (Synthesized
   (Auto TypeCheck)
   (FieldList
      l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
 -> Folded [Error () l])
-> ZipList
     (Synthesized
        (Auto TypeCheck)
        (FieldList
           l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
-> Folded [Error () l]
forall m a. Monoid m => (a -> m) -> ZipList a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((.errors) (Atts
   (Synthesized TypeCheck)
   (FieldList
      l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
 -> Folded [Error () l])
-> (Synthesized
      (Auto TypeCheck)
      (FieldList
         l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
    -> Atts
         (Synthesized TypeCheck)
         (FieldList
            l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
-> Synthesized
     (Auto TypeCheck)
     (FieldList
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Folded [Error () l]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Synthesized
  (Auto TypeCheck)
  (FieldList
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts
     (Synthesized (Auto TypeCheck))
     (FieldList
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
Synthesized
  (Auto TypeCheck)
  (FieldList
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts
     (Synthesized TypeCheck)
     (FieldList
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn) ZipList (Synthesized (Auto TypeCheck) (FieldList l l sem sem))
ZipList
  (Synthesized
     (Auto TypeCheck)
     (FieldList
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
fields',
                $sel:typeName:SynTCType :: Maybe Ident
typeName= Maybe Ident
forall a. Maybe a
Nothing,
                $sel:pointerTarget:SynTCType :: Maybe Ident
pointerTarget= Maybe Ident
forall a. Maybe a
Nothing,
                $sel:definedType:SynTCType :: Type l
definedType= [QualIdent l] -> Map Ident (Type l) -> Type l
forall l. [QualIdent l] -> Map Ident (Type l) -> Type l
RecordType ([QualIdent l]
-> (Type l -> [QualIdent l]) -> Maybe (Type l) -> [QualIdent l]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (([QualIdent l] -> [QualIdent l])
-> (QualIdent l -> [QualIdent l] -> [QualIdent l])
-> Maybe (QualIdent l)
-> [QualIdent l]
-> [QualIdent l]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [QualIdent l] -> [QualIdent l]
forall a. a -> a
id (:) Maybe (QualIdent l)
base ([QualIdent l] -> [QualIdent l])
-> (Type l -> [QualIdent l]) -> Type l -> [QualIdent l]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type l -> [QualIdent l]
forall l. Type l -> [QualIdent l]
ancestry) (Maybe (Type l) -> [QualIdent l])
-> Maybe (Type l) -> [QualIdent l]
forall a b. (a -> b) -> a -> b
$ (Folded [Error () l], Maybe (Type l)) -> Maybe (Type l)
forall a b. (a, b) -> b
snd (Folded [Error () l], Maybe (Type l))
baseRecord)
                                        (Map Ident (Type l)
-> (Type l -> Map Ident (Type l))
-> Maybe (Type l)
-> Map Ident (Type l)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Map Ident (Type l)
forall k a. Map k a
Map.empty Type l -> Map Ident (Type l)
forall l. Type l -> Map Ident (Type l)
recordFields ((Folded [Error () l], Maybe (Type l)) -> Maybe (Type l)
forall a b. (a, b) -> b
snd (Folded [Error () l], Maybe (Type l))
baseRecord)
                                         Map Ident (Type l) -> Map Ident (Type l) -> Map Ident (Type l)
forall a. Semigroup a => a -> a -> a
<> (Synthesized
   (Auto TypeCheck)
   (FieldList
      l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
 -> Map Ident (Type l))
-> ZipList
     (Synthesized
        (Auto TypeCheck)
        (FieldList
           l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
-> Map Ident (Type l)
forall m a. Monoid m => (a -> m) -> ZipList a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (SynTCFields l -> Map Ident (Type l)
forall l. SynTCFields l -> Map Ident (Type l)
fieldEnv (SynTCFields l -> Map Ident (Type l))
-> (Synthesized
      (Auto TypeCheck)
      (FieldList
         l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
    -> SynTCFields l)
-> Synthesized
     (Auto TypeCheck)
     (FieldList
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Map Ident (Type l)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Synthesized
  (Auto TypeCheck)
  (FieldList
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts
     (Synthesized (Auto TypeCheck))
     (FieldList
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
Synthesized
  (Auto TypeCheck)
  (FieldList
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> SynTCFields l
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn) ZipList (Synthesized (Auto TypeCheck) (FieldList l l sem sem))
ZipList
  (Synthesized
     (Auto TypeCheck)
     (FieldList
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
fields')}
     where baseRecord :: (Folded [Error () l], Maybe (Type l))
baseRecord = case (QualIdent l -> Environment l -> Maybe (Type l))
-> Environment l -> QualIdent l -> Maybe (Type l)
forall a b c. (a -> b -> c) -> b -> a -> c
flip QualIdent l -> Environment l -> Maybe (Type l)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Environment l
env (QualIdent l -> Maybe (Type l))
-> Maybe (QualIdent l) -> Maybe (Maybe (Type l))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (QualIdent l)
base
                        of Just (Just t :: Type l
t@RecordType{}) -> (Folded [Error () l]
forall a. Monoid a => a
mempty, Type l -> Maybe (Type l)
forall a. a -> Maybe a
Just Type l
t)
                           Just (Just (NominalType QualIdent l
_ (Just t :: Type l
t@RecordType{}))) -> (Folded [Error () l]
forall a. Monoid a => a
mempty, Type l -> Maybe (Type l)
forall a. a -> Maybe a
Just Type l
t)
                           Just (Just Type l
t) -> ([Error () l] -> Folded [Error () l]
forall a. a -> Folded a
Folded [() -> LexicalPosition -> ErrorType l -> Error () l
forall m l. m -> LexicalPosition -> ErrorType l -> Error m l
Error () LexicalPosition
pos (Type l -> ErrorType l
forall l. Type l -> ErrorType l
NonRecordType Type l
t)], Maybe (Type l)
forall a. Maybe a
Nothing)
                           Just Maybe (Type l)
Nothing ->
                              ((QualIdent l -> Folded [Error () l])
-> Maybe (QualIdent l) -> Folded [Error () l]
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ([Error () l] -> Folded [Error () l]
forall a. a -> Folded a
Folded ([Error () l] -> Folded [Error () l])
-> (QualIdent l -> [Error () l])
-> QualIdent l
-> Folded [Error () l]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Error () l -> [Error () l] -> [Error () l]
forall a. a -> [a] -> [a]
:[]) (Error () l -> [Error () l])
-> (QualIdent l -> Error () l) -> QualIdent l -> [Error () l]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> LexicalPosition -> ErrorType l -> Error () l
forall m l. m -> LexicalPosition -> ErrorType l -> Error m l
Error () LexicalPosition
pos (ErrorType l -> Error () l)
-> (QualIdent l -> ErrorType l) -> QualIdent l -> Error () l
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QualIdent l -> ErrorType l
forall l. QualIdent l -> ErrorType l
UnknownName) Maybe (QualIdent l)
base, Maybe (Type l)
forall a. Maybe a
Nothing)
                           Maybe (Maybe (Type l))
Nothing -> (Folded [Error () l]
forall a. Monoid a => a
mempty, Maybe (Type l)
forall a. Maybe a
Nothing)
   synthesis (Auto TypeCheck
TypeCheck) Placed
  (Type
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
_self Atts (Inherited (Auto TypeCheck)) (Type l l sem sem)
_inheritance (AST.PointerType Synthesized (Auto TypeCheck) (Type l l sem sem)
targetType') =
      SynTCType{$sel:errors:SynTCType :: Folded [Error () l]
errors= (Synthesized
  (Auto TypeCheck)
  (Type
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts
     (Synthesized (Auto TypeCheck))
     (Type
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto TypeCheck) (Type l l sem sem)
Synthesized
  (Auto TypeCheck)
  (Type
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
targetType').errors,
                $sel:typeName:SynTCType :: Maybe Ident
typeName= Maybe Ident
forall a. Maybe a
Nothing,
                $sel:pointerTarget:SynTCType :: Maybe Ident
pointerTarget= SynTCType l -> Maybe Ident
forall l. SynTCType l -> Maybe Ident
typeName (Synthesized
  (Auto TypeCheck)
  (Type
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts
     (Synthesized (Auto TypeCheck))
     (Type
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto TypeCheck) (Type l l sem sem)
Synthesized
  (Auto TypeCheck)
  (Type
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
targetType'),
                $sel:definedType:SynTCType :: Type l
definedType= Type l -> Type l
forall l. Type l -> Type l
PointerType (SynTCType l -> Type l
forall l. SynTCType l -> Type l
definedType (SynTCType l -> Type l) -> SynTCType l -> Type l
forall a b. (a -> b) -> a -> b
$ Synthesized
  (Auto TypeCheck)
  (Type
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts
     (Synthesized (Auto TypeCheck))
     (Type
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto TypeCheck) (Type l l sem sem)
Synthesized
  (Auto TypeCheck)
  (Type
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
targetType')}
   synthesis Auto TypeCheck
_ (LexicalPosition
pos, AST.ProcedureType Maybe
  (Sem
     (FormalParameters
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
signature) Atts (Inherited (Auto TypeCheck)) (Type l l sem sem)
_inheritance (AST.ProcedureType Maybe (Synthesized (Auto TypeCheck) (FormalParameters l l sem sem))
signature') = 
      SynTCType{$sel:errors:SynTCType :: Folded [Error () l]
errors= (Synthesized
   (Auto TypeCheck)
   (FormalParameters
      l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
 -> Folded [Error () l])
-> Maybe
     (Synthesized
        (Auto TypeCheck)
        (FormalParameters
           l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
-> Folded [Error () l]
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((.errors) (Atts
   (Synthesized TypeCheck)
   (FormalParameters
      l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
 -> Folded [Error () l])
-> (Synthesized
      (Auto TypeCheck)
      (FormalParameters
         l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
    -> Atts
         (Synthesized TypeCheck)
         (FormalParameters
            l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
-> Synthesized
     (Auto TypeCheck)
     (FormalParameters
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Folded [Error () l]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Synthesized
  (Auto TypeCheck)
  (FormalParameters
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts
     (Synthesized (Auto TypeCheck))
     (FormalParameters
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
Synthesized
  (Auto TypeCheck)
  (FormalParameters
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts
     (Synthesized TypeCheck)
     (FormalParameters
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn) Maybe (Synthesized (Auto TypeCheck) (FormalParameters l l sem sem))
Maybe
  (Synthesized
     (Auto TypeCheck)
     (FormalParameters
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
signature',
                $sel:typeName:SynTCType :: Maybe Ident
typeName= Maybe Ident
forall a. Maybe a
Nothing,
                $sel:pointerTarget:SynTCType :: Maybe Ident
pointerTarget= Maybe Ident
forall a. Maybe a
Nothing,
                $sel:definedType:SynTCType :: Type l
definedType= Type l
-> (Synthesized
      (Auto TypeCheck)
      (FormalParameters
         l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
    -> Type l)
-> Maybe
     (Synthesized
        (Auto TypeCheck)
        (FormalParameters
           l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
-> Type l
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Bool -> [(Bool, Type l)] -> Maybe (Type l) -> Type l
forall l. Bool -> [(Bool, Type l)] -> Maybe (Type l) -> Type l
ProcedureType Bool
False [] Maybe (Type l)
forall a. Maybe a
Nothing) (SynTCSig l -> Type l
forall l. SynTCSig l -> Type l
signatureType (SynTCSig l -> Type l)
-> (Synthesized
      (Auto TypeCheck)
      (FormalParameters
         l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
    -> SynTCSig l)
-> Synthesized
     (Auto TypeCheck)
     (FormalParameters
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Type l
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Synthesized
  (Auto TypeCheck)
  (FormalParameters
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts
     (Synthesized (Auto TypeCheck))
     (FormalParameters
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
Synthesized
  (Auto TypeCheck)
  (FormalParameters
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> SynTCSig l
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn) Maybe (Synthesized (Auto TypeCheck) (FormalParameters l l sem sem))
Maybe
  (Synthesized
     (Auto TypeCheck)
     (FormalParameters
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
signature'}

instance (Abstract.Nameable l, Atts (Synthesized (Auto TypeCheck)) (Abstract.Type l l Sem Sem) ~ SynTCType l) =>
         SynthesizedField "fieldEnv" (Map AST.Ident (Type l)) (Auto TypeCheck) (AST.FieldList l l) Sem Placed where
   synthesizedField :: forall (sem :: * -> *).
(sem ~ Semantics (Auto TypeCheck)) =>
Proxy "fieldEnv"
-> Auto TypeCheck
-> Placed
     (FieldList
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts (Inherited (Auto TypeCheck)) (FieldList l l sem sem)
-> FieldList l l sem (Synthesized (Auto TypeCheck))
-> Map Ident (Type l)
synthesizedField Proxy "fieldEnv"
_ Auto TypeCheck
_ (LexicalPosition
_, AST.FieldList IdentList l
names Sem
  (Type
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
_declaredType) Atts (Inherited (Auto TypeCheck)) (FieldList l l sem sem)
_inheritance (AST.FieldList IdentList l
_names Synthesized (Auto TypeCheck) (Type l l sem sem)
declaredType) =
      (IdentDef l -> Map Ident (Type l))
-> IdentList l -> Map Ident (Type l)
forall m a. Monoid m => (a -> m) -> NonEmpty a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\IdentDef l
name-> Ident -> Type l -> Map Ident (Type l)
forall k a. k -> a -> Map k a
Map.singleton (IdentDef l -> Ident
forall l. Nameable l => IdentDef l -> Ident
Abstract.getIdentDefName IdentDef l
name) (SynTCType l -> Type l
forall l. SynTCType l -> Type l
definedType (SynTCType l -> Type l) -> SynTCType l -> Type l
forall a b. (a -> b) -> a -> b
$ Synthesized
  (Auto TypeCheck)
  (Type
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts
     (Synthesized (Auto TypeCheck))
     (Type
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto TypeCheck) (Type l l sem sem)
Synthesized
  (Auto TypeCheck)
  (Type
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
declaredType)) IdentList l
names

instance (Abstract.Wirthy l, Abstract.Nameable l, Ord (Abstract.QualIdent l),
          Atts (Inherited (Auto TypeCheck)) (Abstract.StatementSequence l l Sem Sem) ~ InhTC l,
          Atts (Inherited (Auto TypeCheck)) (Abstract.ConditionalBranch l l Sem Sem) ~ InhTC l,
          Atts (Inherited (Auto TypeCheck)) (Abstract.Case l l Sem Sem) ~ InhTCExp l,
          Atts (Inherited (Auto TypeCheck)) (Abstract.WithAlternative l l Sem Sem) ~ InhTC l,
          Atts (Inherited (Auto TypeCheck)) (Abstract.Expression l l Sem Sem) ~ InhTC l,
          Atts (Inherited (Auto TypeCheck)) (Abstract.Designator l l Sem Sem) ~ InhTC l,
          Atts (Synthesized (Auto TypeCheck)) (Abstract.Expression l l Sem Sem) ~ SynTCExp l) =>
         Bequether (Auto TypeCheck) (AST.Statement l l) Sem Placed where
   bequest :: forall (sem :: * -> *).
(sem ~ Semantics (Auto TypeCheck)) =>
Auto TypeCheck
-> Placed
     (Statement
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts (Inherited (Auto TypeCheck)) (Statement l l sem sem)
-> Statement l l sem (Synthesized (Auto TypeCheck))
-> Statement l l sem (Inherited (Auto TypeCheck))
bequest Auto TypeCheck
_ (LexicalPosition
_pos, AST.CaseStatement{}) i :: Atts (Inherited (Auto TypeCheck)) (Statement l l sem sem)
i@InhTC{Map (QualIdent l) (Type l)
$sel:env:InhTC :: forall l. InhTC l -> Environment l
env :: Map (QualIdent l) (Type l)
env} (AST.CaseStatement Synthesized (Auto TypeCheck) (Expression l l sem sem)
value ZipList (Synthesized (Auto TypeCheck) (Case l l sem sem))
_branches Maybe
  (Synthesized (Auto TypeCheck) (StatementSequence l l sem sem))
_fallback) =
      Inherited (Auto TypeCheck) (Expression l l sem sem)
-> ZipList (Inherited (Auto TypeCheck) (Case l l sem sem))
-> Maybe
     (Inherited (Auto TypeCheck) (StatementSequence l l sem sem))
-> Statement l l sem (Inherited (Auto TypeCheck))
forall λ l (f' :: * -> *) (f :: * -> *).
f (Expression l l f' f')
-> ZipList (f (Case l l f' f'))
-> Maybe (f (StatementSequence l l f' f'))
-> Statement λ l f' f
AST.CaseStatement (Atts
  (Inherited (Auto TypeCheck))
  (Expression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Inherited
     (Auto TypeCheck)
     (Expression
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
forall t a. Atts (Inherited t) a -> Inherited t a
Inherited Atts
  (Inherited (Auto TypeCheck))
  (Expression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
Atts (Inherited (Auto TypeCheck)) (Statement l l sem sem)
i) (Inherited (Auto TypeCheck) (Case l l sem sem)
-> ZipList (Inherited (Auto TypeCheck) (Case l l sem sem))
forall a. a -> ZipList a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inherited (Auto TypeCheck) (Case l l sem sem)
 -> ZipList (Inherited (Auto TypeCheck) (Case l l sem sem)))
-> Inherited (Auto TypeCheck) (Case l l sem sem)
-> ZipList (Inherited (Auto TypeCheck) (Case l l sem sem))
forall a b. (a -> b) -> a -> b
$ Atts
  (Inherited (Auto TypeCheck))
  (Case
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Inherited
     (Auto TypeCheck)
     (Case
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
forall t a. Atts (Inherited t) a -> Inherited t a
Inherited InhTCExp{$sel:env:InhTCExp :: Map (QualIdent l) (Type l)
env= Map (QualIdent l) (Type l)
env,
                                                                 $sel:expectedType:InhTCExp :: Type l
expectedType= SynTCExp l -> Type l
forall l. SynTCExp l -> Type l
inferredType (SynTCExp l -> Type l) -> SynTCExp l -> Type l
forall a b. (a -> b) -> a -> b
$ Synthesized
  (Auto TypeCheck)
  (Expression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts
     (Synthesized (Auto TypeCheck))
     (Expression
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto TypeCheck) (Expression l l sem sem)
Synthesized
  (Auto TypeCheck)
  (Expression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
value})
                        (Inherited (Auto TypeCheck) (StatementSequence l l sem sem)
-> Maybe
     (Inherited (Auto TypeCheck) (StatementSequence l l sem sem))
forall a. a -> Maybe a
Just (Inherited (Auto TypeCheck) (StatementSequence l l sem sem)
 -> Maybe
      (Inherited (Auto TypeCheck) (StatementSequence l l sem sem)))
-> Inherited (Auto TypeCheck) (StatementSequence l l sem sem)
-> Maybe
     (Inherited (Auto TypeCheck) (StatementSequence l l sem sem))
forall a b. (a -> b) -> a -> b
$ Atts
  (Inherited (Auto TypeCheck))
  (StatementSequence
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Inherited
     (Auto TypeCheck)
     (StatementSequence
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
forall t a. Atts (Inherited t) a -> Inherited t a
Inherited Atts
  (Inherited (Auto TypeCheck))
  (StatementSequence
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
Atts (Inherited (Auto TypeCheck)) (Statement l l sem sem)
i)
   bequest Auto TypeCheck
_ (LexicalPosition
_pos, Statement
  l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))
statement) InhTC{Map (QualIdent l) (Type l)
$sel:env:InhTC :: forall l. InhTC l -> Environment l
env :: Map (QualIdent l) (Type l)
env} Statement l l sem (Synthesized (Auto TypeCheck))
_ =
      InhTCExp l
-> Statement l l sem (Semantics (Auto TypeCheck))
-> Statement l l sem (Inherited (Auto TypeCheck))
forall {k} t (g :: k -> (* -> *) -> *) (shallow :: * -> *)
       (deep :: k) atts.
Functor (PassDown t shallow atts) (g deep) =>
atts -> g deep shallow -> g deep (Inherited t)
AG.passDown InhTCExp{$sel:env:InhTCExp :: Map (QualIdent l) (Type l)
env= Map (QualIdent l) (Type l)
env,
                           $sel:expectedType:InhTCExp :: Type l
expectedType= String -> Type l
forall a. HasCallStack => String -> a
error String
"No statement except CASE needs expectedType"} Statement l l sem (Semantics (Auto TypeCheck))
Statement
  l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))
statement

instance {-# overlaps #-} (Abstract.Wirthy l, Abstract.Nameable l, Ord (Abstract.QualIdent l),
                           Atts (Synthesized (Auto TypeCheck)) (Abstract.StatementSequence l l Sem Sem) ~ SynTC l,
                           Atts (Synthesized (Auto TypeCheck)) (Abstract.Expression l l Sem Sem) ~ SynTCExp l,
                           Atts (Synthesized (Auto TypeCheck)) (Abstract.Designator l l Sem Sem) ~ SynTCDes l,
                           Atts (Synthesized (Auto TypeCheck)) (Abstract.Case l l Sem Sem) ~ SynTC l,
                           Atts (Synthesized (Auto TypeCheck)) (Abstract.ConditionalBranch l l Sem Sem) ~ SynTC l,
                           Atts (Synthesized (Auto TypeCheck)) (Abstract.WithAlternative l l Sem Sem) ~ SynTC l) =>
                          Synthesizer (Auto TypeCheck) (AST.Statement l l) Sem Placed where
   synthesis :: forall (sem :: * -> *).
(sem ~ Semantics (Auto TypeCheck)) =>
Auto TypeCheck
-> Placed
     (Statement
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts (Inherited (Auto TypeCheck)) (Statement l l sem sem)
-> Statement l l sem (Synthesized (Auto TypeCheck))
-> Atts (Synthesized (Auto TypeCheck)) (Statement l l sem sem)
synthesis Auto TypeCheck
t (LexicalPosition
pos, Statement
  l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))
_) InhTC{} statement :: Statement l l sem (Synthesized (Auto TypeCheck))
statement@(AST.Assignment Synthesized (Auto TypeCheck) (Designator l l sem sem)
var Synthesized (Auto TypeCheck) (Expression l l sem sem)
value) =
      {-# SCC "Assignment" #-}
      SynTC{$sel:errors:SynTC :: Folded [Error () l]
errors= LexicalPosition -> Type l -> Type l -> Folded [Error () l]
forall l.
(Nameable l, Eq (QualIdent l)) =>
LexicalPosition -> Type l -> Type l -> Folded [Error () l]
assignmentCompatible LexicalPosition
pos (SynTCDes l -> Type l
forall l. SynTCDes l -> Type l
designatorType (SynTCDes l -> Type l) -> SynTCDes l -> Type l
forall a b. (a -> b) -> a -> b
$ Synthesized
  (Auto TypeCheck)
  (Designator
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts
     (Synthesized (Auto TypeCheck))
     (Designator
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto TypeCheck) (Designator l l sem sem)
Synthesized
  (Auto TypeCheck)
  (Designator
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
var) (SynTCExp l -> Type l
forall l. SynTCExp l -> Type l
inferredType (SynTCExp l -> Type l) -> SynTCExp l -> Type l
forall a b. (a -> b) -> a -> b
$ Synthesized
  (Auto TypeCheck)
  (Expression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts
     (Synthesized (Auto TypeCheck))
     (Expression
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto TypeCheck) (Expression l l sem sem)
Synthesized
  (Auto TypeCheck)
  (Expression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
value)
                    Folded [Error () l] -> Folded [Error () l] -> Folded [Error () l]
forall a. Semigroup a => a -> a -> a
<> Proxy "errors"
-> Auto TypeCheck
-> Statement l l sem (Synthesized (Auto TypeCheck))
-> Folded [Error () l]
forall {k} (name :: Symbol) t (g :: k -> (* -> *) -> *) a
       (sem :: k).
(Monoid a, Foldable (Accumulator t name a) (g sem)) =>
Proxy name -> t -> g sem (Synthesized t) -> Folded a
AG.foldedField (Proxy "errors"
forall {k} (t :: k). Proxy t
Proxy :: Proxy "errors") Auto TypeCheck
t Statement l l sem (Synthesized (Auto TypeCheck))
statement}
   synthesis Auto TypeCheck
_ (LexicalPosition
pos, AST.ProcedureCall Sem
  (Designator
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
_proc Maybe
  (ZipList
     (Sem
        (Expression
           l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))))
parameters) Atts (Inherited (Auto TypeCheck)) (Statement l l sem sem)
_inheritance (AST.ProcedureCall Synthesized (Auto TypeCheck) (Designator l l sem sem)
procedure' Maybe
  (ZipList (Synthesized (Auto TypeCheck) (Expression l l sem sem)))
parameters') =
      SynTC{$sel:errors:SynTC :: Folded [Error () l]
errors= (case Synthesized
  (Auto TypeCheck)
  (Designator
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts
     (Synthesized (Auto TypeCheck))
     (Designator
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto TypeCheck) (Designator l l sem sem)
Synthesized
  (Auto TypeCheck)
  (Designator
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
procedure'
                     of SynTCDes{$sel:errors:SynTCDes :: forall l. SynTCDes l -> Folded [Error () l]
errors= Folded [],
                                 $sel:designatorType:SynTCDes :: forall l. SynTCDes l -> Type l
designatorType= Type l
t} -> Type l -> Folded [Error () l]
procedureErrors Type l
t
                        SynTCDes{$sel:errors:SynTCDes :: forall l. SynTCDes l -> Folded [Error () l]
errors= Folded [Error () l]
errs} -> Folded [Error () l]
errs)
                    Folded [Error () l] -> Folded [Error () l] -> Folded [Error () l]
forall a. Semigroup a => a -> a -> a
<> (ZipList
   (Synthesized
      (Auto TypeCheck)
      (Expression
         l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
 -> Folded [Error () l])
-> Maybe
     (ZipList
        (Synthesized
           (Auto TypeCheck)
           (Expression
              l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))))
-> Folded [Error () l]
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((Synthesized
   (Auto TypeCheck)
   (Expression
      l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
 -> Folded [Error () l])
-> ZipList
     (Synthesized
        (Auto TypeCheck)
        (Expression
           l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
-> Folded [Error () l]
forall m a. Monoid m => (a -> m) -> ZipList a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((.errors) (Atts
   (Synthesized TypeCheck)
   (Expression
      l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
 -> Folded [Error () l])
-> (Synthesized
      (Auto TypeCheck)
      (Expression
         l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
    -> Atts
         (Synthesized TypeCheck)
         (Expression
            l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
-> Synthesized
     (Auto TypeCheck)
     (Expression
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Folded [Error () l]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Synthesized
  (Auto TypeCheck)
  (Expression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts
     (Synthesized (Auto TypeCheck))
     (Expression
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
Synthesized
  (Auto TypeCheck)
  (Expression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts
     (Synthesized TypeCheck)
     (Expression
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn)) Maybe
  (ZipList (Synthesized (Auto TypeCheck) (Expression l l sem sem)))
Maybe
  (ZipList
     (Synthesized
        (Auto TypeCheck)
        (Expression
           l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))))
parameters'}
     where procedureErrors :: Type l -> Folded [Error () l]
procedureErrors (ProcedureType Bool
_ [(Bool, Type l)]
formalTypes Maybe (Type l)
Nothing)
             | [(Bool, Type l)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Bool, Type l)]
formalTypes Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
-> (ZipList
      (Sem
         (Expression
            l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
    -> Int)
-> Maybe
     (ZipList
        (Sem
           (Expression
              l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))))
-> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 ([Sem
   (Expression
      l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))]
-> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Sem
    (Expression
       l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))]
 -> Int)
-> (ZipList
      (Sem
         (Expression
            l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
    -> [Sem
          (Expression
             l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))])
-> ZipList
     (Sem
        (Expression
           l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ZipList
  (Sem
     (Expression
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
-> [Sem
      (Expression
         l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))]
forall a. ZipList a -> [a]
getZipList) Maybe
  (ZipList
     (Sem
        (Expression
           l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))))
parameters,
               Bool -> Bool
not ([(Bool, Type l)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Bool, Type l)]
formalTypes Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 Bool -> Bool -> Bool
&& ([Sem
   (Expression
      l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))]
-> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Sem
    (Expression
       l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))]
 -> Int)
-> (ZipList
      (Sem
         (Expression
            l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
    -> [Sem
          (Expression
             l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))])
-> ZipList
     (Sem
        (Expression
           l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ZipList
  (Sem
     (Expression
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
-> [Sem
      (Expression
         l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))]
forall a. ZipList a -> [a]
getZipList (ZipList
   (Sem
      (Expression
         l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
 -> Int)
-> Maybe
     (ZipList
        (Sem
           (Expression
              l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))))
-> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe
  (ZipList
     (Sem
        (Expression
           l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))))
parameters) Maybe Int -> Maybe Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1
                    Bool -> Bool -> Bool
&& SynTCDes l -> Maybe (Maybe Ident, Ident)
forall l. SynTCDes l -> Maybe (Maybe Ident, Ident)
designatorName (Synthesized
  (Auto TypeCheck)
  (Designator
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts
     (Synthesized (Auto TypeCheck))
     (Designator
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto TypeCheck) (Designator l l sem sem)
Synthesized
  (Auto TypeCheck)
  (Designator
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
procedure') Maybe (Maybe Ident, Ident) -> Maybe (Maybe Ident, Ident) -> Bool
forall a. Eq a => a -> a -> Bool
== (Maybe Ident, Ident) -> Maybe (Maybe Ident, Ident)
forall a. a -> Maybe a
Just (Maybe Ident
forall a. Maybe a
Nothing, Ident
"ASSERT")
                    Bool -> Bool -> Bool
|| [(Bool, Type l)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Bool, Type l)]
formalTypes Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
&& ([Sem
   (Expression
      l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))]
-> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Sem
    (Expression
       l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))]
 -> Int)
-> (ZipList
      (Sem
         (Expression
            l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
    -> [Sem
          (Expression
             l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))])
-> ZipList
     (Sem
        (Expression
           l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ZipList
  (Sem
     (Expression
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
-> [Sem
      (Expression
         l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))]
forall a. ZipList a -> [a]
getZipList (ZipList
   (Sem
      (Expression
         l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
 -> Int)
-> Maybe
     (ZipList
        (Sem
           (Expression
              l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))))
-> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe
  (ZipList
     (Sem
        (Expression
           l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))))
parameters) Maybe Int -> Maybe Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Maybe Int
forall a. a -> Maybe a
Just Int
2
                    Bool -> Bool -> Bool
&& SynTCDes l -> Maybe (Maybe Ident, Ident)
forall l. SynTCDes l -> Maybe (Maybe Ident, Ident)
designatorName (Synthesized
  (Auto TypeCheck)
  (Designator
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts
     (Synthesized (Auto TypeCheck))
     (Designator
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto TypeCheck) (Designator l l sem sem)
Synthesized
  (Auto TypeCheck)
  (Designator
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
procedure') Maybe (Maybe Ident, Ident) -> Maybe (Maybe Ident, Ident) -> Bool
forall a. Eq a => a -> a -> Bool
== (Maybe Ident, Ident) -> Maybe (Maybe Ident, Ident)
forall a. a -> Maybe a
Just (Maybe Ident
forall a. Maybe a
Nothing, Ident
"NEW")
                    Bool -> Bool -> Bool
&& (ZipList
   (Synthesized
      (Auto TypeCheck)
      (Expression
         l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
 -> Bool)
-> Maybe
     (ZipList
        (Synthesized
           (Auto TypeCheck)
           (Expression
              l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))))
-> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((Synthesized
   (Auto TypeCheck)
   (Expression
      l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
 -> Bool)
-> [Synthesized
      (Auto TypeCheck)
      (Expression
         l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))]
-> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Type l -> Bool
forall {l}. Type l -> Bool
isIntegerType (Type l -> Bool)
-> (Synthesized
      (Auto TypeCheck)
      (Expression
         l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
    -> Type l)
-> Synthesized
     (Auto TypeCheck)
     (Expression
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SynTCExp l -> Type l
forall l. SynTCExp l -> Type l
inferredType (SynTCExp l -> Type l)
-> (Synthesized
      (Auto TypeCheck)
      (Expression
         l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
    -> SynTCExp l)
-> Synthesized
     (Auto TypeCheck)
     (Expression
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Type l
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Synthesized
  (Auto TypeCheck)
  (Expression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts
     (Synthesized (Auto TypeCheck))
     (Expression
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
Synthesized
  (Auto TypeCheck)
  (Expression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> SynTCExp l
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn) ([Synthesized
    (Auto TypeCheck)
    (Expression
       l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))]
 -> Bool)
-> (ZipList
      (Synthesized
         (Auto TypeCheck)
         (Expression
            l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
    -> [Synthesized
          (Auto TypeCheck)
          (Expression
             l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))])
-> ZipList
     (Synthesized
        (Auto TypeCheck)
        (Expression
           l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Synthesized
   (Auto TypeCheck)
   (Expression
      l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))]
-> [Synthesized
      (Auto TypeCheck)
      (Expression
         l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))]
forall a. HasCallStack => [a] -> [a]
tail ([Synthesized
    (Auto TypeCheck)
    (Expression
       l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))]
 -> [Synthesized
       (Auto TypeCheck)
       (Expression
          l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))])
-> (ZipList
      (Synthesized
         (Auto TypeCheck)
         (Expression
            l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
    -> [Synthesized
          (Auto TypeCheck)
          (Expression
             l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))])
-> ZipList
     (Synthesized
        (Auto TypeCheck)
        (Expression
           l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
-> [Synthesized
      (Auto TypeCheck)
      (Expression
         l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ZipList
  (Synthesized
     (Auto TypeCheck)
     (Expression
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
-> [Synthesized
      (Auto TypeCheck)
      (Expression
         l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))]
forall a. ZipList a -> [a]
getZipList) Maybe
  (ZipList (Synthesized (Auto TypeCheck) (Expression l l sem sem)))
Maybe
  (ZipList
     (Synthesized
        (Auto TypeCheck)
        (Expression
           l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))))
parameters') =
                 [Error () l] -> Folded [Error () l]
forall a. a -> Folded a
Folded [() -> LexicalPosition -> ErrorType l -> Error () l
forall m l. m -> LexicalPosition -> ErrorType l -> Error m l
Error () LexicalPosition
pos
                         (ErrorType l -> Error () l) -> ErrorType l -> Error () l
forall a b. (a -> b) -> a -> b
$ Int -> Int -> ErrorType l
forall l. Int -> Int -> ErrorType l
ArgumentCountMismatch ([(Bool, Type l)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Bool, Type l)]
formalTypes) (Int -> ErrorType l) -> Int -> ErrorType l
forall a b. (a -> b) -> a -> b
$ Int
-> (ZipList
      (Sem
         (Expression
            l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
    -> Int)
-> Maybe
     (ZipList
        (Sem
           (Expression
              l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))))
-> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 ([Sem
   (Expression
      l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))]
-> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Sem
    (Expression
       l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))]
 -> Int)
-> (ZipList
      (Sem
         (Expression
            l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
    -> [Sem
          (Expression
             l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))])
-> ZipList
     (Sem
        (Expression
           l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ZipList
  (Sem
     (Expression
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
-> [Sem
      (Expression
         l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))]
forall a. ZipList a -> [a]
getZipList) Maybe
  (ZipList
     (Sem
        (Expression
           l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))))
parameters]
             | Bool
otherwise = [Folded [Error () l]] -> Folded [Error () l]
forall a. Monoid a => [a] -> a
mconcat (((Bool, Type l) -> Type l -> Folded [Error () l])
-> [(Bool, Type l)] -> [Type l] -> [Folded [Error () l]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (LexicalPosition -> (Bool, Type l) -> Type l -> Folded [Error () l]
forall l.
(Nameable l, Eq (QualIdent l)) =>
LexicalPosition -> (Bool, Type l) -> Type l -> Folded [Error () l]
parameterCompatible LexicalPosition
pos) [(Bool, Type l)]
formalTypes
                                    ([Type l] -> [Folded [Error () l]])
-> [Type l] -> [Folded [Error () l]]
forall a b. (a -> b) -> a -> b
$ [Type l]
-> (ZipList
      (Synthesized
         (Auto TypeCheck)
         (Expression
            l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
    -> [Type l])
-> Maybe
     (ZipList
        (Synthesized
           (Auto TypeCheck)
           (Expression
              l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))))
-> [Type l]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ((SynTCExp l -> Type l
forall l. SynTCExp l -> Type l
inferredType (SynTCExp l -> Type l)
-> (Synthesized
      (Auto TypeCheck)
      (Expression
         l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
    -> SynTCExp l)
-> Synthesized
     (Auto TypeCheck)
     (Expression
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Type l
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Synthesized
  (Auto TypeCheck)
  (Expression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts
     (Synthesized (Auto TypeCheck))
     (Expression
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
Synthesized
  (Auto TypeCheck)
  (Expression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> SynTCExp l
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn (Synthesized
   (Auto TypeCheck)
   (Expression
      l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
 -> Type l)
-> [Synthesized
      (Auto TypeCheck)
      (Expression
         l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))]
-> [Type l]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) ([Synthesized
    (Auto TypeCheck)
    (Expression
       l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))]
 -> [Type l])
-> (ZipList
      (Synthesized
         (Auto TypeCheck)
         (Expression
            l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
    -> [Synthesized
          (Auto TypeCheck)
          (Expression
             l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))])
-> ZipList
     (Synthesized
        (Auto TypeCheck)
        (Expression
           l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
-> [Type l]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ZipList
  (Synthesized
     (Auto TypeCheck)
     (Expression
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
-> [Synthesized
      (Auto TypeCheck)
      (Expression
         l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))]
forall a. ZipList a -> [a]
getZipList) Maybe
  (ZipList (Synthesized (Auto TypeCheck) (Expression l l sem sem)))
Maybe
  (ZipList
     (Synthesized
        (Auto TypeCheck)
        (Expression
           l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))))
parameters')
           procedureErrors (NominalType QualIdent l
_ (Just Type l
t)) = Type l -> Folded [Error () l]
procedureErrors Type l
t
           procedureErrors Type l
t = [Error () l] -> Folded [Error () l]
forall a. a -> Folded a
Folded [() -> LexicalPosition -> ErrorType l -> Error () l
forall m l. m -> LexicalPosition -> ErrorType l -> Error m l
Error () LexicalPosition
pos (Type l -> ErrorType l
forall l. Type l -> ErrorType l
NonProcedureType Type l
t)]
   synthesis Auto TypeCheck
_ (LexicalPosition
pos, Statement
  l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))
_) Atts (Inherited (Auto TypeCheck)) (Statement l l sem sem)
_inheritance (AST.While Synthesized (Auto TypeCheck) (Expression l l sem sem)
condition Synthesized (Auto TypeCheck) (StatementSequence l l sem sem)
body) =
      SynTC{$sel:errors:SynTC :: Folded [Error () l]
errors= LexicalPosition -> SynTCExp l -> Folded [Error () l]
forall l. LexicalPosition -> SynTCExp l -> Folded [Error () l]
booleanExpressionErrors LexicalPosition
pos (Synthesized
  (Auto TypeCheck)
  (Expression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts
     (Synthesized (Auto TypeCheck))
     (Expression
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto TypeCheck) (Expression l l sem sem)
Synthesized
  (Auto TypeCheck)
  (Expression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
condition) Folded [Error () l] -> Folded [Error () l] -> Folded [Error () l]
forall a. Semigroup a => a -> a -> a
<> (Synthesized
  (Auto TypeCheck)
  (StatementSequence
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts
     (Synthesized (Auto TypeCheck))
     (StatementSequence
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto TypeCheck) (StatementSequence l l sem sem)
Synthesized
  (Auto TypeCheck)
  (StatementSequence
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
body).errors}
   synthesis Auto TypeCheck
_ (LexicalPosition
pos, Statement
  l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))
_) Atts (Inherited (Auto TypeCheck)) (Statement l l sem sem)
_inheritance (AST.Repeat Synthesized (Auto TypeCheck) (StatementSequence l l sem sem)
body Synthesized (Auto TypeCheck) (Expression l l sem sem)
condition) =
      SynTC{$sel:errors:SynTC :: Folded [Error () l]
errors= LexicalPosition -> SynTCExp l -> Folded [Error () l]
forall l. LexicalPosition -> SynTCExp l -> Folded [Error () l]
booleanExpressionErrors LexicalPosition
pos (Synthesized
  (Auto TypeCheck)
  (Expression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts
     (Synthesized (Auto TypeCheck))
     (Expression
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto TypeCheck) (Expression l l sem sem)
Synthesized
  (Auto TypeCheck)
  (Expression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
condition) Folded [Error () l] -> Folded [Error () l] -> Folded [Error () l]
forall a. Semigroup a => a -> a -> a
<> (Synthesized
  (Auto TypeCheck)
  (StatementSequence
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts
     (Synthesized (Auto TypeCheck))
     (StatementSequence
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto TypeCheck) (StatementSequence l l sem sem)
Synthesized
  (Auto TypeCheck)
  (StatementSequence
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
body).errors}
   synthesis Auto TypeCheck
_ (LexicalPosition
pos, Statement
  l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))
_) Atts (Inherited (Auto TypeCheck)) (Statement l l sem sem)
_inheritance (AST.For Ident
_counter Synthesized (Auto TypeCheck) (Expression l l sem sem)
start Synthesized (Auto TypeCheck) (Expression l l sem sem)
end Maybe (Synthesized (Auto TypeCheck) (Expression l l sem sem))
step Synthesized (Auto TypeCheck) (StatementSequence l l sem sem)
body) =
      SynTC{$sel:errors:SynTC :: Folded [Error () l]
errors= LexicalPosition -> SynTCExp l -> Folded [Error () l]
forall l. LexicalPosition -> SynTCExp l -> Folded [Error () l]
integerExpressionErrors LexicalPosition
pos (Synthesized
  (Auto TypeCheck)
  (Expression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts
     (Synthesized (Auto TypeCheck))
     (Expression
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto TypeCheck) (Expression l l sem sem)
Synthesized
  (Auto TypeCheck)
  (Expression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
start) 
                    Folded [Error () l] -> Folded [Error () l] -> Folded [Error () l]
forall a. Semigroup a => a -> a -> a
<> LexicalPosition -> SynTCExp l -> Folded [Error () l]
forall l. LexicalPosition -> SynTCExp l -> Folded [Error () l]
integerExpressionErrors LexicalPosition
pos (Synthesized
  (Auto TypeCheck)
  (Expression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts
     (Synthesized (Auto TypeCheck))
     (Expression
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto TypeCheck) (Expression l l sem sem)
Synthesized
  (Auto TypeCheck)
  (Expression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
end)
                    Folded [Error () l] -> Folded [Error () l] -> Folded [Error () l]
forall a. Semigroup a => a -> a -> a
<> (Synthesized
   (Auto TypeCheck)
   (Expression
      l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
 -> Folded [Error () l])
-> Maybe
     (Synthesized
        (Auto TypeCheck)
        (Expression
           l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
-> Folded [Error () l]
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (LexicalPosition -> SynTCExp l -> Folded [Error () l]
forall l. LexicalPosition -> SynTCExp l -> Folded [Error () l]
integerExpressionErrors LexicalPosition
pos (SynTCExp l -> Folded [Error () l])
-> (Synthesized
      (Auto TypeCheck)
      (Expression
         l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
    -> SynTCExp l)
-> Synthesized
     (Auto TypeCheck)
     (Expression
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Folded [Error () l]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Synthesized
  (Auto TypeCheck)
  (Expression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts
     (Synthesized (Auto TypeCheck))
     (Expression
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
Synthesized
  (Auto TypeCheck)
  (Expression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> SynTCExp l
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn) Maybe (Synthesized (Auto TypeCheck) (Expression l l sem sem))
Maybe
  (Synthesized
     (Auto TypeCheck)
     (Expression
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
step Folded [Error () l] -> Folded [Error () l] -> Folded [Error () l]
forall a. Semigroup a => a -> a -> a
<> (Synthesized
  (Auto TypeCheck)
  (StatementSequence
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts
     (Synthesized (Auto TypeCheck))
     (StatementSequence
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto TypeCheck) (StatementSequence l l sem sem)
Synthesized
  (Auto TypeCheck)
  (StatementSequence
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
body).errors}
   synthesis Auto TypeCheck
t Placed
  (Statement
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
self Atts (Inherited (Auto TypeCheck)) (Statement l l sem sem)
_ Statement l l sem (Synthesized (Auto TypeCheck))
statement = SynTC{$sel:errors:SynTC :: Folded [Error () l]
errors= Proxy "errors"
-> Auto TypeCheck
-> Statement l l sem (Synthesized (Auto TypeCheck))
-> Folded [Error () l]
forall {k} (name :: Symbol) t (g :: k -> (* -> *) -> *) a
       (sem :: k).
(Monoid a, Foldable (Accumulator t name a) (g sem)) =>
Proxy name -> t -> g sem (Synthesized t) -> Folded a
AG.foldedField (Proxy "errors"
forall {k} (t :: k). Proxy t
Proxy :: Proxy "errors") Auto TypeCheck
t Statement l l sem (Synthesized (Auto TypeCheck))
statement}

instance (Abstract.Nameable l, Ord (Abstract.QualIdent l),
          Atts (Inherited (Auto TypeCheck)) (Abstract.StatementSequence l l Sem Sem) ~ InhTC l,
          Atts (Synthesized (Auto TypeCheck)) (Abstract.StatementSequence l l Sem Sem) ~ SynTC l) =>
         Attribution (Auto TypeCheck) (AST.WithAlternative l l) Sem Placed where
   attribution :: Auto TypeCheck
-> Placed
     (WithAlternative
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Rule (Auto TypeCheck) (WithAlternative l l)
attribution Auto TypeCheck
_ (LexicalPosition
pos, AST.WithAlternative QualIdent l
var QualIdent l
subtype Sem
  (StatementSequence
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
_body)
               (Inherited InhTC{Environment l
$sel:env:InhTC :: forall l. InhTC l -> Environment l
env :: Environment l
env},
                AST.WithAlternative QualIdent l
_var QualIdent l
_subtype Synthesized (Auto TypeCheck) (StatementSequence l l sem sem)
body) =
      (Atts
  (Synthesized (Auto TypeCheck))
  (WithAlternative l l sem (Semantics (Auto TypeCheck)))
-> Synthesized
     (Auto TypeCheck)
     (WithAlternative l l sem (Semantics (Auto TypeCheck)))
forall t a. Atts (Synthesized t) a -> Synthesized t a
Synthesized SynTC{$sel:errors:SynTC :: Folded [Error () l]
errors= case (QualIdent l -> Environment l -> Maybe (Type l)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup QualIdent l
var Environment l
env, QualIdent l -> Environment l -> Maybe (Type l)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup QualIdent l
subtype Environment l
env)
                                 of (Just Type l
supertype, Just Type l
subtypeDef) ->
                                      LexicalPosition -> Type l -> Type l -> Folded [Error () l]
forall l.
(Nameable l, Eq (QualIdent l)) =>
LexicalPosition -> Type l -> Type l -> Folded [Error () l]
assignmentCompatible LexicalPosition
pos Type l
supertype Type l
subtypeDef
                                    (Maybe (Type l)
Nothing, Maybe (Type l)
_) -> [Error () l] -> Folded [Error () l]
forall a. a -> Folded a
Folded [() -> LexicalPosition -> ErrorType l -> Error () l
forall m l. m -> LexicalPosition -> ErrorType l -> Error m l
Error () LexicalPosition
pos (QualIdent l -> ErrorType l
forall l. QualIdent l -> ErrorType l
UnknownName QualIdent l
var)]
                                    (Maybe (Type l)
_, Maybe (Type l)
Nothing) -> [Error () l] -> Folded [Error () l]
forall a. a -> Folded a
Folded [() -> LexicalPosition -> ErrorType l -> Error () l
forall m l. m -> LexicalPosition -> ErrorType l -> Error m l
Error () LexicalPosition
pos (QualIdent l -> ErrorType l
forall l. QualIdent l -> ErrorType l
UnknownName QualIdent l
subtype)]
                                 Folded [Error () l] -> Folded [Error () l] -> Folded [Error () l]
forall a. Semigroup a => a -> a -> a
<> (Synthesized
  (Auto TypeCheck)
  (StatementSequence
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts
     (Synthesized (Auto TypeCheck))
     (StatementSequence
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto TypeCheck) (StatementSequence l l sem sem)
Synthesized
  (Auto TypeCheck)
  (StatementSequence
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
body).errors},
       QualIdent l
-> QualIdent l
-> Inherited (Auto TypeCheck) (StatementSequence l l sem sem)
-> WithAlternative l l sem (Inherited (Auto TypeCheck))
forall λ l (f' :: * -> *) (f :: * -> *).
QualIdent l
-> QualIdent l
-> f (StatementSequence l l f' f')
-> WithAlternative λ l f' f
AST.WithAlternative QualIdent l
var QualIdent l
subtype (Atts (Inherited (Auto TypeCheck)) (StatementSequence l l sem sem)
-> Inherited (Auto TypeCheck) (StatementSequence l l sem sem)
forall t a. Atts (Inherited t) a -> Inherited t a
Inherited (Atts (Inherited (Auto TypeCheck)) (StatementSequence l l sem sem)
 -> Inherited (Auto TypeCheck) (StatementSequence l l sem sem))
-> Atts
     (Inherited (Auto TypeCheck)) (StatementSequence l l sem sem)
-> Inherited (Auto TypeCheck) (StatementSequence l l sem sem)
forall a b. (a -> b) -> a -> b
$ Environment l -> InhTC l
forall l. Environment l -> InhTC l
InhTC (Environment l -> InhTC l) -> Environment l -> InhTC l
forall a b. (a -> b) -> a -> b
$ (Environment l -> Environment l)
-> (Type l -> Environment l -> Environment l)
-> Maybe (Type l)
-> Environment l
-> Environment l
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Environment l -> Environment l
forall a. a -> a
id (QualIdent l -> Type l -> Environment l -> Environment l
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert QualIdent l
var) (QualIdent l -> Environment l -> Maybe (Type l)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup QualIdent l
subtype Environment l
env) Environment l
env))

instance (Abstract.Nameable l,
          Atts (Synthesized (Auto TypeCheck)) (Abstract.Expression l l Sem Sem) ~ SynTCExp l,
          Atts (Synthesized (Auto TypeCheck)) (Abstract.StatementSequence l l Sem Sem) ~ SynTC l) =>
         Synthesizer (Auto TypeCheck) (AST.ConditionalBranch l l) Sem Placed where
   synthesis :: forall (sem :: * -> *).
(sem ~ Semantics (Auto TypeCheck)) =>
Auto TypeCheck
-> Placed
     (ConditionalBranch
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts
     (Inherited (Auto TypeCheck)) (ConditionalBranch l l sem sem)
-> ConditionalBranch l l sem (Synthesized (Auto TypeCheck))
-> Atts
     (Synthesized (Auto TypeCheck)) (ConditionalBranch l l sem sem)
synthesis Auto TypeCheck
_ (LexicalPosition
pos, ConditionalBranch
  l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))
_) Atts (Inherited (Auto TypeCheck)) (ConditionalBranch l l sem sem)
_inheritance (AST.ConditionalBranch Synthesized (Auto TypeCheck) (Expression l l sem sem)
condition Synthesized (Auto TypeCheck) (StatementSequence l l sem sem)
body) =
      SynTC{$sel:errors:SynTC :: Folded [Error () l]
errors= LexicalPosition -> SynTCExp l -> Folded [Error () l]
forall l. LexicalPosition -> SynTCExp l -> Folded [Error () l]
booleanExpressionErrors LexicalPosition
pos (Synthesized
  (Auto TypeCheck)
  (Expression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts
     (Synthesized (Auto TypeCheck))
     (Expression
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto TypeCheck) (Expression l l sem sem)
Synthesized
  (Auto TypeCheck)
  (Expression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
condition) Folded [Error () l] -> Folded [Error () l] -> Folded [Error () l]
forall a. Semigroup a => a -> a -> a
<> (Synthesized
  (Auto TypeCheck)
  (StatementSequence
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts
     (Synthesized (Auto TypeCheck))
     (StatementSequence
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto TypeCheck) (StatementSequence l l sem sem)
Synthesized
  (Auto TypeCheck)
  (StatementSequence
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
body).errors}

instance {-# overlaps #-} (Abstract.Nameable l, Eq (Abstract.QualIdent l),
                           Atts (Synthesized (Auto TypeCheck)) (Abstract.ConstExpression l l Sem Sem) ~ SynTCExp l) =>
                          Synthesizer (Auto TypeCheck) (AST.CaseLabels l l) Sem Placed where
   synthesis :: forall (sem :: * -> *).
(sem ~ Semantics (Auto TypeCheck)) =>
Auto TypeCheck
-> Placed
     (CaseLabels
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts (Inherited (Auto TypeCheck)) (CaseLabels l l sem sem)
-> CaseLabels l l sem (Synthesized (Auto TypeCheck))
-> Atts (Synthesized (Auto TypeCheck)) (CaseLabels l l sem sem)
synthesis Auto TypeCheck
_ (LexicalPosition
pos, CaseLabels
  l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))
_) Atts (Inherited (Auto TypeCheck)) (CaseLabels l l sem sem)
inheritance (AST.SingleLabel Synthesized (Auto TypeCheck) (ConstExpression l l sem sem)
value) =
      SynTC{$sel:errors:SynTC :: Folded [Error () l]
errors= InhTCExp l -> LexicalPosition -> Type l -> Folded [Error () l]
forall l.
(Nameable l, Eq (QualIdent l)) =>
InhTCExp l -> LexicalPosition -> Type l -> Folded [Error () l]
assignmentCompatibleIn Atts (Inherited (Auto TypeCheck)) (CaseLabels l l sem sem)
InhTCExp l
inheritance LexicalPosition
pos (SynTCExp l -> Type l
forall l. SynTCExp l -> Type l
inferredType (SynTCExp l -> Type l) -> SynTCExp l -> Type l
forall a b. (a -> b) -> a -> b
$ Synthesized
  (Auto TypeCheck)
  (ConstExpression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts
     (Synthesized (Auto TypeCheck))
     (ConstExpression
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto TypeCheck) (ConstExpression l l sem sem)
Synthesized
  (Auto TypeCheck)
  (ConstExpression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
value)}
   synthesis Auto TypeCheck
_ (LexicalPosition
pos, CaseLabels
  l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))
_) Atts (Inherited (Auto TypeCheck)) (CaseLabels l l sem sem)
inheritance (AST.LabelRange Synthesized (Auto TypeCheck) (ConstExpression l l sem sem)
start Synthesized (Auto TypeCheck) (ConstExpression l l sem sem)
end) =
      SynTC{$sel:errors:SynTC :: Folded [Error () l]
errors= InhTCExp l -> LexicalPosition -> Type l -> Folded [Error () l]
forall l.
(Nameable l, Eq (QualIdent l)) =>
InhTCExp l -> LexicalPosition -> Type l -> Folded [Error () l]
assignmentCompatibleIn Atts (Inherited (Auto TypeCheck)) (CaseLabels l l sem sem)
InhTCExp l
inheritance LexicalPosition
pos (SynTCExp l -> Type l
forall l. SynTCExp l -> Type l
inferredType (SynTCExp l -> Type l) -> SynTCExp l -> Type l
forall a b. (a -> b) -> a -> b
$ Synthesized
  (Auto TypeCheck)
  (ConstExpression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts
     (Synthesized (Auto TypeCheck))
     (ConstExpression
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto TypeCheck) (ConstExpression l l sem sem)
Synthesized
  (Auto TypeCheck)
  (ConstExpression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
start)
                    Folded [Error () l] -> Folded [Error () l] -> Folded [Error () l]
forall a. Semigroup a => a -> a -> a
<> InhTCExp l -> LexicalPosition -> Type l -> Folded [Error () l]
forall l.
(Nameable l, Eq (QualIdent l)) =>
InhTCExp l -> LexicalPosition -> Type l -> Folded [Error () l]
assignmentCompatibleIn Atts (Inherited (Auto TypeCheck)) (CaseLabels l l sem sem)
InhTCExp l
inheritance LexicalPosition
pos (SynTCExp l -> Type l
forall l. SynTCExp l -> Type l
inferredType (SynTCExp l -> Type l) -> SynTCExp l -> Type l
forall a b. (a -> b) -> a -> b
$ Synthesized
  (Auto TypeCheck)
  (ConstExpression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts
     (Synthesized (Auto TypeCheck))
     (ConstExpression
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto TypeCheck) (ConstExpression l l sem sem)
Synthesized
  (Auto TypeCheck)
  (ConstExpression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
end)}

instance {-# overlaps #-} (Abstract.Nameable l, Ord (Abstract.QualIdent l),
                           Atts (Inherited (Auto TypeCheck)) (Abstract.Expression l l Sem Sem) ~ InhTC l,
                           Atts (Synthesized (Auto TypeCheck)) (Abstract.Expression l l Sem Sem) ~ SynTCExp l,
                           Atts (Synthesized (Auto TypeCheck)) (Abstract.Element l l Sem Sem) ~ SynTCExp l,
                           Atts (Synthesized (Auto TypeCheck)) (Abstract.Value l l Sem Sem) ~ SynTCExp l,
                           Atts (Synthesized (Auto TypeCheck)) (Abstract.Designator l l Sem Sem) ~ SynTCDes l) =>
                          Synthesizer (Auto TypeCheck) (AST.Expression l l) Sem Placed where
   synthesis :: forall (sem :: * -> *).
(sem ~ Semantics (Auto TypeCheck)) =>
Auto TypeCheck
-> Placed
     (Expression
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts (Inherited (Auto TypeCheck)) (Expression l l sem sem)
-> Expression l l sem (Synthesized (Auto TypeCheck))
-> Atts (Synthesized (Auto TypeCheck)) (Expression l l sem sem)
synthesis Auto TypeCheck
_ (LexicalPosition
pos, AST.Relation RelOp
op Sem
  (Expression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
_ Sem
  (Expression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
_) InhTC{} (AST.Relation RelOp
_op Synthesized (Auto TypeCheck) (Expression l l sem sem)
left Synthesized (Auto TypeCheck) (Expression l l sem sem)
right) =
      SynTCExp{$sel:errors:SynTCExp :: Folded [Error () l]
errors= case (Synthesized
  (Auto TypeCheck)
  (Expression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts
     (Synthesized (Auto TypeCheck))
     (Expression
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto TypeCheck) (Expression l l sem sem)
Synthesized
  (Auto TypeCheck)
  (Expression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
left).errors Folded [Error () l] -> Folded [Error () l] -> Folded [Error () l]
forall a. Semigroup a => a -> a -> a
<> (Synthesized
  (Auto TypeCheck)
  (Expression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts
     (Synthesized (Auto TypeCheck))
     (Expression
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto TypeCheck) (Expression l l sem sem)
Synthesized
  (Auto TypeCheck)
  (Expression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
right).errors
                       of Folded []
                            | Type l
t1 Type l -> Type l -> Bool
forall a. Eq a => a -> a -> Bool
== Type l
t2 -> Folded [Error () l]
forall a. Monoid a => a
mempty
                            | RelOp
AST.In <- RelOp
op -> Type l -> Type l -> Folded [Error () l]
membershipCompatible (Type l -> Type l
forall l. Type l -> Type l
ultimate Type l
t1) (Type l -> Type l
forall l. Type l -> Type l
ultimate Type l
t2)
                            | RelOp -> Bool
equality RelOp
op,
                              Folded [] <- LexicalPosition -> Type l -> Type l -> Folded [Error () l]
forall l.
(Nameable l, Eq (QualIdent l)) =>
LexicalPosition -> Type l -> Type l -> Folded [Error () l]
assignmentCompatible LexicalPosition
pos Type l
t1 Type l
t2
                              -> Folded [Error () l]
forall a. Monoid a => a
mempty
                            | RelOp -> Bool
equality RelOp
op,
                              Folded [] <- LexicalPosition -> Type l -> Type l -> Folded [Error () l]
forall l.
(Nameable l, Eq (QualIdent l)) =>
LexicalPosition -> Type l -> Type l -> Folded [Error () l]
assignmentCompatible LexicalPosition
pos Type l
t2 Type l
t1
                              -> Folded [Error () l]
forall a. Monoid a => a
mempty
                            | Bool
otherwise -> Type l -> Type l -> Folded [Error () l]
comparable (Type l -> Type l
forall l. Type l -> Type l
ultimate Type l
t1) (Type l -> Type l
forall l. Type l -> Type l
ultimate Type l
t2)
                          Folded [Error () l]
errs -> Folded [Error () l]
errs,
               $sel:inferredType:SynTCExp :: Type l
inferredType= Ident -> Type l
forall l. Ident -> Type l
BuiltinType Ident
"BOOLEAN"}
      where t1 :: Type l
t1 = SynTCExp l -> Type l
forall l. SynTCExp l -> Type l
inferredType (Synthesized
  (Auto TypeCheck)
  (Expression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts
     (Synthesized (Auto TypeCheck))
     (Expression
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto TypeCheck) (Expression l l sem sem)
Synthesized
  (Auto TypeCheck)
  (Expression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
left)
            t2 :: Type l
t2 = SynTCExp l -> Type l
forall l. SynTCExp l -> Type l
inferredType (Synthesized
  (Auto TypeCheck)
  (Expression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts
     (Synthesized (Auto TypeCheck))
     (Expression
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto TypeCheck) (Expression l l sem sem)
Synthesized
  (Auto TypeCheck)
  (Expression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
right)
            equality :: RelOp -> Bool
equality RelOp
AST.Equal = Bool
True
            equality RelOp
AST.Unequal = Bool
True
            equality RelOp
_ = Bool
False
            comparable :: Type l -> Type l -> Folded [Error () l]
comparable (BuiltinType Ident
"BOOLEAN") (BuiltinType Ident
"BOOLEAN") = Folded [Error () l]
forall a. Monoid a => a
mempty
            comparable (BuiltinType Ident
"CHAR") (BuiltinType Ident
"CHAR") = Folded [Error () l]
forall a. Monoid a => a
mempty
            comparable StringType{} StringType{} = Folded [Error () l]
forall a. Monoid a => a
mempty
            comparable (StringType Int
1) (BuiltinType Ident
"CHAR") = Folded [Error () l]
forall a. Monoid a => a
mempty
            comparable (BuiltinType Ident
"CHAR") (StringType Int
1) = Folded [Error () l]
forall a. Monoid a => a
mempty
            comparable StringType{} (ArrayType [Int]
_ (BuiltinType Ident
"CHAR")) = Folded [Error () l]
forall a. Monoid a => a
mempty
            comparable (ArrayType [Int]
_ (BuiltinType Ident
"CHAR")) StringType{} = Folded [Error () l]
forall a. Monoid a => a
mempty
            comparable (ArrayType [Int]
_ (BuiltinType Ident
"CHAR")) (ArrayType [Int]
_ (BuiltinType Ident
"CHAR")) = Folded [Error () l]
forall a. Monoid a => a
mempty
            comparable (BuiltinType Ident
t1) (BuiltinType Ident
t2)
               | Ident -> Bool
isNumerical Ident
t1 Bool -> Bool -> Bool
&& Ident -> Bool
isNumerical Ident
t2 = Folded [Error () l]
forall a. Monoid a => a
mempty
            comparable (BuiltinType Ident
t1) IntegerType{}
               | Ident -> Bool
isNumerical Ident
t1 = Folded [Error () l]
forall a. Monoid a => a
mempty
            comparable IntegerType{} (BuiltinType Ident
t2)
               | Ident -> Bool
isNumerical Ident
t2 = Folded [Error () l]
forall a. Monoid a => a
mempty
            comparable Type l
t1 Type l
t2 = [Error () l] -> Folded [Error () l]
forall a. a -> Folded a
Folded [() -> LexicalPosition -> ErrorType l -> Error () l
forall m l. m -> LexicalPosition -> ErrorType l -> Error m l
Error () LexicalPosition
pos (Type l -> Type l -> ErrorType l
forall l. Type l -> Type l -> ErrorType l
IncomparableTypes Type l
t1 Type l
t2)]
            membershipCompatible :: Type l -> Type l -> Folded [Error () l]
membershipCompatible IntegerType{} (BuiltinType Ident
"SET") = Folded [Error () l]
forall a. Monoid a => a
mempty
            membershipCompatible (BuiltinType Ident
t1) (BuiltinType Ident
"SET")
               | Ident -> Bool
isNumerical Ident
t1 = Folded [Error () l]
forall a. Monoid a => a
mempty
   synthesis Auto TypeCheck
_ (LexicalPosition
pos, AST.IsA Sem
  (Expression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
_ QualIdent l
q) InhTC{Environment l
$sel:env:InhTC :: forall l. InhTC l -> Environment l
env :: Environment l
env} (AST.IsA Synthesized (Auto TypeCheck) (Expression l l sem sem)
left QualIdent l
_) =
      SynTCExp{$sel:errors:SynTCExp :: Folded [Error () l]
errors= case QualIdent l -> Environment l -> Maybe (Type l)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup QualIdent l
q Environment l
env
                       of Maybe (Type l)
Nothing -> [Error () l] -> Folded [Error () l]
forall a. a -> Folded a
Folded [() -> LexicalPosition -> ErrorType l -> Error () l
forall m l. m -> LexicalPosition -> ErrorType l -> Error m l
Error () LexicalPosition
pos (QualIdent l -> ErrorType l
forall l. QualIdent l -> ErrorType l
UnknownName QualIdent l
q)]
                          Just Type l
t -> LexicalPosition -> Type l -> Type l -> Folded [Error () l]
forall l.
(Nameable l, Eq (QualIdent l)) =>
LexicalPosition -> Type l -> Type l -> Folded [Error () l]
assignmentCompatible LexicalPosition
pos (SynTCExp l -> Type l
forall l. SynTCExp l -> Type l
inferredType (SynTCExp l -> Type l) -> SynTCExp l -> Type l
forall a b. (a -> b) -> a -> b
$ Synthesized
  (Auto TypeCheck)
  (Expression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts
     (Synthesized (Auto TypeCheck))
     (Expression
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto TypeCheck) (Expression l l sem sem)
Synthesized
  (Auto TypeCheck)
  (Expression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
left) Type l
t,
               $sel:inferredType:SynTCExp :: Type l
inferredType= Ident -> Type l
forall l. Ident -> Type l
BuiltinType Ident
"BOOLEAN"}
   synthesis Auto TypeCheck
_ (LexicalPosition
pos, Expression
  l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))
_) Atts (Inherited (Auto TypeCheck)) (Expression l l sem sem)
_inheritance (AST.Positive Synthesized (Auto TypeCheck) (Expression l l sem sem)
expr) =
      SynTCExp{$sel:errors:SynTCExp :: Folded [Error () l]
errors= LexicalPosition -> SynTCExp l -> Folded [Error () l]
forall l.
Nameable l =>
LexicalPosition -> SynTCExp l -> Folded [Error () l]
unaryNumericOrSetOperatorErrors LexicalPosition
pos (Synthesized
  (Auto TypeCheck)
  (Expression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts
     (Synthesized (Auto TypeCheck))
     (Expression
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto TypeCheck) (Expression l l sem sem)
Synthesized
  (Auto TypeCheck)
  (Expression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
expr),
               $sel:inferredType:SynTCExp :: Type l
inferredType= SynTCExp l -> Type l
forall l. SynTCExp l -> Type l
inferredType (Synthesized
  (Auto TypeCheck)
  (Expression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts
     (Synthesized (Auto TypeCheck))
     (Expression
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto TypeCheck) (Expression l l sem sem)
Synthesized
  (Auto TypeCheck)
  (Expression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
expr)}
   synthesis Auto TypeCheck
_ (LexicalPosition
pos, Expression
  l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))
_) Atts (Inherited (Auto TypeCheck)) (Expression l l sem sem)
_inheritance (AST.Negative Synthesized (Auto TypeCheck) (Expression l l sem sem)
expr) =
      SynTCExp{$sel:errors:SynTCExp :: Folded [Error () l]
errors= LexicalPosition -> SynTCExp l -> Folded [Error () l]
forall l.
Nameable l =>
LexicalPosition -> SynTCExp l -> Folded [Error () l]
unaryNumericOrSetOperatorErrors LexicalPosition
pos (Synthesized
  (Auto TypeCheck)
  (Expression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts
     (Synthesized (Auto TypeCheck))
     (Expression
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto TypeCheck) (Expression l l sem sem)
Synthesized
  (Auto TypeCheck)
  (Expression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
expr),
               $sel:inferredType:SynTCExp :: Type l
inferredType= (Int -> Int) -> SynTCExp l -> Type l
forall l. (Int -> Int) -> SynTCExp l -> Type l
unaryNumericOrSetOperatorType Int -> Int
forall a. Num a => a -> a
negate (Synthesized
  (Auto TypeCheck)
  (Expression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts
     (Synthesized (Auto TypeCheck))
     (Expression
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto TypeCheck) (Expression l l sem sem)
Synthesized
  (Auto TypeCheck)
  (Expression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
expr)}
   synthesis Auto TypeCheck
_ (LexicalPosition
pos, Expression
  l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))
_) Atts (Inherited (Auto TypeCheck)) (Expression l l sem sem)
_inheritance (AST.Add Synthesized (Auto TypeCheck) (Expression l l sem sem)
left Synthesized (Auto TypeCheck) (Expression l l sem sem)
right) = LexicalPosition
-> Synthesized
     (Auto TypeCheck)
     (Expression
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Synthesized
     (Auto TypeCheck)
     (Expression
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> SynTCExp l
forall {t} {a} {l} {t} {a}.
(Atts (Synthesized t) a ~ SynTCExp l,
 Atts (Synthesized t) a ~ SynTCExp l, Nameable l,
 Eq (QualIdent l)) =>
LexicalPosition -> Synthesized t a -> Synthesized t a -> SynTCExp l
binaryNumericOrSetSynthesis LexicalPosition
pos Synthesized (Auto TypeCheck) (Expression l l sem sem)
Synthesized
  (Auto TypeCheck)
  (Expression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
left Synthesized (Auto TypeCheck) (Expression l l sem sem)
Synthesized
  (Auto TypeCheck)
  (Expression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
right
   synthesis Auto TypeCheck
_ (LexicalPosition
pos, Expression
  l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))
_) Atts (Inherited (Auto TypeCheck)) (Expression l l sem sem)
_inheritance (AST.Subtract Synthesized (Auto TypeCheck) (Expression l l sem sem)
left Synthesized (Auto TypeCheck) (Expression l l sem sem)
right) = LexicalPosition
-> Synthesized
     (Auto TypeCheck)
     (Expression
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Synthesized
     (Auto TypeCheck)
     (Expression
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> SynTCExp l
forall {t} {a} {l} {t} {a}.
(Atts (Synthesized t) a ~ SynTCExp l,
 Atts (Synthesized t) a ~ SynTCExp l, Nameable l,
 Eq (QualIdent l)) =>
LexicalPosition -> Synthesized t a -> Synthesized t a -> SynTCExp l
binaryNumericOrSetSynthesis LexicalPosition
pos Synthesized (Auto TypeCheck) (Expression l l sem sem)
Synthesized
  (Auto TypeCheck)
  (Expression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
left Synthesized (Auto TypeCheck) (Expression l l sem sem)
Synthesized
  (Auto TypeCheck)
  (Expression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
right
   synthesis Auto TypeCheck
_ (LexicalPosition
pos, Expression
  l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))
_) Atts (Inherited (Auto TypeCheck)) (Expression l l sem sem)
_inheritance (AST.Or Synthesized (Auto TypeCheck) (Expression l l sem sem)
left Synthesized (Auto TypeCheck) (Expression l l sem sem)
right) = LexicalPosition
-> Synthesized
     (Auto TypeCheck)
     (Expression
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Synthesized
     (Auto TypeCheck)
     (Expression
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> SynTCExp l
forall {t} {a} {l} {t} {a}.
(Atts (Synthesized t) a ~ SynTCExp l,
 Atts (Synthesized t) a ~ SynTCExp l, Nameable l,
 Eq (QualIdent l)) =>
LexicalPosition -> Synthesized t a -> Synthesized t a -> SynTCExp l
binaryBooleanSynthesis LexicalPosition
pos Synthesized (Auto TypeCheck) (Expression l l sem sem)
Synthesized
  (Auto TypeCheck)
  (Expression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
left Synthesized (Auto TypeCheck) (Expression l l sem sem)
Synthesized
  (Auto TypeCheck)
  (Expression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
right
   synthesis Auto TypeCheck
_ (LexicalPosition
pos, Expression
  l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))
_) Atts (Inherited (Auto TypeCheck)) (Expression l l sem sem)
_inheritance (AST.Multiply Synthesized (Auto TypeCheck) (Expression l l sem sem)
left Synthesized (Auto TypeCheck) (Expression l l sem sem)
right) = LexicalPosition
-> Synthesized
     (Auto TypeCheck)
     (Expression
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Synthesized
     (Auto TypeCheck)
     (Expression
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> SynTCExp l
forall {t} {a} {l} {t} {a}.
(Atts (Synthesized t) a ~ SynTCExp l,
 Atts (Synthesized t) a ~ SynTCExp l, Nameable l,
 Eq (QualIdent l)) =>
LexicalPosition -> Synthesized t a -> Synthesized t a -> SynTCExp l
binaryNumericOrSetSynthesis LexicalPosition
pos Synthesized (Auto TypeCheck) (Expression l l sem sem)
Synthesized
  (Auto TypeCheck)
  (Expression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
left Synthesized (Auto TypeCheck) (Expression l l sem sem)
Synthesized
  (Auto TypeCheck)
  (Expression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
right
   synthesis Auto TypeCheck
_ (LexicalPosition
pos, Expression
  l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))
_) InhTC{} (AST.Divide Synthesized (Auto TypeCheck) (Expression l l sem sem)
left Synthesized (Auto TypeCheck) (Expression l l sem sem)
right) =
      SynTCExp{$sel:errors:SynTCExp :: Folded [Error () l]
errors=
                  case (Synthesized
  (Auto TypeCheck)
  (Expression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts
     (Synthesized (Auto TypeCheck))
     (Expression
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto TypeCheck) (Expression l l sem sem)
Synthesized
  (Auto TypeCheck)
  (Expression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
left, Synthesized
  (Auto TypeCheck)
  (Expression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts
     (Synthesized (Auto TypeCheck))
     (Expression
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto TypeCheck) (Expression l l sem sem)
Synthesized
  (Auto TypeCheck)
  (Expression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
right)
                  of (SynTCExp{$sel:errors:SynTCExp :: forall l. SynTCExp l -> Folded [Error () l]
errors= Folded [], $sel:inferredType:SynTCExp :: forall l. SynTCExp l -> Type l
inferredType= BuiltinType Ident
t1},
                      SynTCExp{$sel:errors:SynTCExp :: forall l. SynTCExp l -> Folded [Error () l]
errors= Folded [], $sel:inferredType:SynTCExp :: forall l. SynTCExp l -> Type l
inferredType= BuiltinType Ident
t2})
                        | Ident
t1 Ident -> Ident -> Bool
forall a. Eq a => a -> a -> Bool
== Ident
"REAL", Ident
t2 Ident -> Ident -> Bool
forall a. Eq a => a -> a -> Bool
== Ident
"REAL" -> Folded [Error () l]
forall a. Monoid a => a
mempty
                        | Ident
t1 Ident -> Ident -> Bool
forall a. Eq a => a -> a -> Bool
== Ident
"SET", Ident
t2 Ident -> Ident -> Bool
forall a. Eq a => a -> a -> Bool
== Ident
"SET" -> Folded [Error () l]
forall a. Monoid a => a
mempty
                     (SynTCExp{$sel:errors:SynTCExp :: forall l. SynTCExp l -> Folded [Error () l]
errors= Folded [], $sel:inferredType:SynTCExp :: forall l. SynTCExp l -> Type l
inferredType= Type l
t1},
                      SynTCExp{$sel:errors:SynTCExp :: forall l. SynTCExp l -> Folded [Error () l]
errors= Folded [], $sel:inferredType:SynTCExp :: forall l. SynTCExp l -> Type l
inferredType= Type l
t2})
                       | Type l
t1 Type l -> Type l -> Bool
forall a. Eq a => a -> a -> Bool
== Type l
t2 -> [Error () l] -> Folded [Error () l]
forall a. a -> Folded a
Folded [() -> LexicalPosition -> ErrorType l -> Error () l
forall m l. m -> LexicalPosition -> ErrorType l -> Error m l
Error () LexicalPosition
pos (Type l -> ErrorType l
forall l. Type l -> ErrorType l
UnrealType Type l
t1)]
                       | Bool
otherwise -> [Error () l] -> Folded [Error () l]
forall a. a -> Folded a
Folded [() -> LexicalPosition -> ErrorType l -> Error () l
forall m l. m -> LexicalPosition -> ErrorType l -> Error m l
Error () LexicalPosition
pos (Type l -> Type l -> ErrorType l
forall l. Type l -> Type l -> ErrorType l
TypeMismatch Type l
t1 Type l
t2)],
               $sel:inferredType:SynTCExp :: Type l
inferredType= Ident -> Type l
forall l. Ident -> Type l
BuiltinType Ident
"REAL"}
   synthesis Auto TypeCheck
_ (LexicalPosition
pos, Expression
  l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))
_) Atts (Inherited (Auto TypeCheck)) (Expression l l sem sem)
_inheritance (AST.IntegerDivide Synthesized (Auto TypeCheck) (Expression l l sem sem)
left Synthesized (Auto TypeCheck) (Expression l l sem sem)
right) = LexicalPosition
-> Synthesized
     (Auto TypeCheck)
     (Expression
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Synthesized
     (Auto TypeCheck)
     (Expression
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> SynTCExp l
forall {t} {a} {l} {t} {a}.
(Atts (Synthesized t) a ~ SynTCExp l,
 Atts (Synthesized t) a ~ SynTCExp l, Nameable l,
 Eq (QualIdent l)) =>
LexicalPosition -> Synthesized t a -> Synthesized t a -> SynTCExp l
binaryIntegerSynthesis LexicalPosition
pos Synthesized (Auto TypeCheck) (Expression l l sem sem)
Synthesized
  (Auto TypeCheck)
  (Expression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
left Synthesized (Auto TypeCheck) (Expression l l sem sem)
Synthesized
  (Auto TypeCheck)
  (Expression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
right
   synthesis Auto TypeCheck
_ (LexicalPosition
pos, Expression
  l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))
_) Atts (Inherited (Auto TypeCheck)) (Expression l l sem sem)
_inheritance (AST.Modulo Synthesized (Auto TypeCheck) (Expression l l sem sem)
left Synthesized (Auto TypeCheck) (Expression l l sem sem)
right) = LexicalPosition
-> Synthesized
     (Auto TypeCheck)
     (Expression
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Synthesized
     (Auto TypeCheck)
     (Expression
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> SynTCExp l
forall {t} {a} {l} {t} {a}.
(Atts (Synthesized t) a ~ SynTCExp l,
 Atts (Synthesized t) a ~ SynTCExp l, Nameable l,
 Eq (QualIdent l)) =>
LexicalPosition -> Synthesized t a -> Synthesized t a -> SynTCExp l
binaryIntegerSynthesis LexicalPosition
pos Synthesized (Auto TypeCheck) (Expression l l sem sem)
Synthesized
  (Auto TypeCheck)
  (Expression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
left Synthesized (Auto TypeCheck) (Expression l l sem sem)
Synthesized
  (Auto TypeCheck)
  (Expression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
right
   synthesis Auto TypeCheck
_ (LexicalPosition
pos, Expression
  l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))
_) Atts (Inherited (Auto TypeCheck)) (Expression l l sem sem)
_inheritance (AST.And Synthesized (Auto TypeCheck) (Expression l l sem sem)
left Synthesized (Auto TypeCheck) (Expression l l sem sem)
right) = LexicalPosition
-> Synthesized
     (Auto TypeCheck)
     (Expression
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Synthesized
     (Auto TypeCheck)
     (Expression
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> SynTCExp l
forall {t} {a} {l} {t} {a}.
(Atts (Synthesized t) a ~ SynTCExp l,
 Atts (Synthesized t) a ~ SynTCExp l, Nameable l,
 Eq (QualIdent l)) =>
LexicalPosition -> Synthesized t a -> Synthesized t a -> SynTCExp l
binaryBooleanSynthesis LexicalPosition
pos Synthesized (Auto TypeCheck) (Expression l l sem sem)
Synthesized
  (Auto TypeCheck)
  (Expression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
left Synthesized (Auto TypeCheck) (Expression l l sem sem)
Synthesized
  (Auto TypeCheck)
  (Expression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
right
   synthesis (Auto TypeCheck
TypeCheck) Placed
  (Expression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
_self Atts (Inherited (Auto TypeCheck)) (Expression l l sem sem)
_ (AST.Set ZipList (Synthesized (Auto TypeCheck) (Element l l sem sem))
elements) =
      SynTCExp{$sel:errors:SynTCExp :: Folded [Error () l]
errors= Folded [Error () l]
forall a. Monoid a => a
mempty,
               $sel:inferredType:SynTCExp :: Type l
inferredType= Ident -> Type l
forall l. Ident -> Type l
BuiltinType Ident
"SET"}
   synthesis (Auto TypeCheck
TypeCheck) Placed
  (Expression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
_self Atts (Inherited (Auto TypeCheck)) (Expression l l sem sem)
_ (AST.Read Synthesized (Auto TypeCheck) (Designator l l sem sem)
designator) =
      SynTCExp{$sel:errors:SynTCExp :: Folded [Error () l]
errors= (Synthesized
  (Auto TypeCheck)
  (Designator
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts
     (Synthesized (Auto TypeCheck))
     (Designator
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto TypeCheck) (Designator l l sem sem)
Synthesized
  (Auto TypeCheck)
  (Designator
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
designator).errors,
               $sel:inferredType:SynTCExp :: Type l
inferredType= SynTCDes l -> Type l
forall l. SynTCDes l -> Type l
designatorType (Synthesized
  (Auto TypeCheck)
  (Designator
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts
     (Synthesized (Auto TypeCheck))
     (Designator
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto TypeCheck) (Designator l l sem sem)
Synthesized
  (Auto TypeCheck)
  (Designator
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
designator)}
   synthesis (Auto TypeCheck
TypeCheck) Placed
  (Expression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
_self Atts (Inherited (Auto TypeCheck)) (Expression l l sem sem)
_ (AST.Literal Synthesized (Auto TypeCheck) (Value l l sem sem)
value) =
      SynTCExp{$sel:errors:SynTCExp :: Folded [Error () l]
errors= (Synthesized
  (Auto TypeCheck)
  (Value
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts
     (Synthesized (Auto TypeCheck))
     (Value
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto TypeCheck) (Value l l sem sem)
Synthesized
  (Auto TypeCheck)
  (Value
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
value).errors,
               $sel:inferredType:SynTCExp :: Type l
inferredType= SynTCExp l -> Type l
forall l. SynTCExp l -> Type l
inferredType (Synthesized
  (Auto TypeCheck)
  (Value
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts
     (Synthesized (Auto TypeCheck))
     (Value
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto TypeCheck) (Value l l sem sem)
Synthesized
  (Auto TypeCheck)
  (Value
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
value)}
   synthesis Auto TypeCheck
_ (LexicalPosition
pos, AST.FunctionCall Sem
  (Designator
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
_designator (ZipList [Sem
   (Expression
      l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))]
parameters)) Atts (Inherited (Auto TypeCheck)) (Expression l l sem sem)
_inheritance
             (AST.FunctionCall Synthesized (Auto TypeCheck) (Designator l l sem sem)
designator (ZipList [Synthesized (Auto TypeCheck) (Expression l l sem sem)]
parameters')) =
      SynTCExp{$sel:errors:SynTCExp :: Folded [Error () l]
errors=
                   case {-# SCC "FunctionCall" #-} Synthesized
  (Auto TypeCheck)
  (Designator
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts
     (Synthesized (Auto TypeCheck))
     (Designator
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto TypeCheck) (Designator l l sem sem)
Synthesized
  (Auto TypeCheck)
  (Designator
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
designator
                   of SynTCDes{$sel:errors:SynTCDes :: forall l. SynTCDes l -> Folded [Error () l]
errors= Folded [],
                               $sel:designatorName:SynTCDes :: forall l. SynTCDes l -> Maybe (Maybe Ident, Ident)
designatorName= Maybe (Maybe Ident, Ident)
name,
                               $sel:designatorType:SynTCDes :: forall l. SynTCDes l -> Type l
designatorType= Type l -> Type l
forall l. Type l -> Type l
ultimate -> ProcedureType Bool
_ [(Bool, Type l)]
formalTypes Just{}}
                        | [(Bool, Type l)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Bool, Type l)]
formalTypes Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= [Sem
   (Expression
      l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))]
-> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Sem
   (Expression
      l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))]
parameters ->
                            [Error () l] -> Folded [Error () l]
forall a. a -> Folded a
Folded [() -> LexicalPosition -> ErrorType l -> Error () l
forall m l. m -> LexicalPosition -> ErrorType l -> Error m l
Error () LexicalPosition
pos
                                    (ErrorType l -> Error () l) -> ErrorType l -> Error () l
forall a b. (a -> b) -> a -> b
$ Int -> Int -> ErrorType l
forall l. Int -> Int -> ErrorType l
ArgumentCountMismatch ([(Bool, Type l)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Bool, Type l)]
formalTypes) ([Sem
   (Expression
      l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))]
-> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Sem
   (Expression
      l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))]
parameters)]
                        | Maybe (Maybe Ident, Ident)
name Maybe (Maybe Ident, Ident) -> Maybe (Maybe Ident, Ident) -> Bool
forall a. Eq a => a -> a -> Bool
== (Maybe Ident, Ident) -> Maybe (Maybe Ident, Ident)
forall a. a -> Maybe a
Just (Ident -> Maybe Ident
forall a. a -> Maybe a
Just Ident
"SYSTEM", Ident
"VAL") -> Folded [Error () l]
forall a. Monoid a => a
mempty
                        | Bool
otherwise -> [Folded [Error () l]] -> Folded [Error () l]
forall a. Monoid a => [a] -> a
mconcat (((Bool, Type l) -> Type l -> Folded [Error () l])
-> [(Bool, Type l)] -> [Type l] -> [Folded [Error () l]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (LexicalPosition -> (Bool, Type l) -> Type l -> Folded [Error () l]
forall l.
(Nameable l, Eq (QualIdent l)) =>
LexicalPosition -> (Bool, Type l) -> Type l -> Folded [Error () l]
parameterCompatible LexicalPosition
pos) [(Bool, Type l)]
formalTypes
                                                ([Type l] -> [Folded [Error () l]])
-> [Type l] -> [Folded [Error () l]]
forall a b. (a -> b) -> a -> b
$ SynTCExp l -> Type l
forall l. SynTCExp l -> Type l
inferredType (SynTCExp l -> Type l)
-> (Synthesized
      (Auto TypeCheck)
      (Expression
         l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
    -> SynTCExp l)
-> Synthesized
     (Auto TypeCheck)
     (Expression
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Type l
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Synthesized
  (Auto TypeCheck)
  (Expression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts
     (Synthesized (Auto TypeCheck))
     (Expression
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
Synthesized
  (Auto TypeCheck)
  (Expression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> SynTCExp l
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn (Synthesized
   (Auto TypeCheck)
   (Expression
      l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
 -> Type l)
-> [Synthesized
      (Auto TypeCheck)
      (Expression
         l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))]
-> [Type l]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Synthesized (Auto TypeCheck) (Expression l l sem sem)]
[Synthesized
   (Auto TypeCheck)
   (Expression
      l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))]
parameters')
                      SynTCDes{$sel:errors:SynTCDes :: forall l. SynTCDes l -> Folded [Error () l]
errors= Folded [],
                               $sel:designatorType:SynTCDes :: forall l. SynTCDes l -> Type l
designatorType= Type l
t} -> [Error () l] -> Folded [Error () l]
forall a. a -> Folded a
Folded [() -> LexicalPosition -> ErrorType l -> Error () l
forall m l. m -> LexicalPosition -> ErrorType l -> Error m l
Error () LexicalPosition
pos (Type l -> ErrorType l
forall l. Type l -> ErrorType l
NonFunctionType Type l
t)]
                      SynTCDes{$sel:errors:SynTCDes :: forall l. SynTCDes l -> Folded [Error () l]
errors= Folded [Error () l]
errs} -> Folded [Error () l]
errs
                   Folded [Error () l] -> Folded [Error () l] -> Folded [Error () l]
forall a. Semigroup a => a -> a -> a
<> (Synthesized
   (Auto TypeCheck)
   (Expression
      l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
 -> Folded [Error () l])
-> [Synthesized
      (Auto TypeCheck)
      (Expression
         l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))]
-> Folded [Error () l]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((.errors) (Atts
   (Synthesized TypeCheck)
   (Expression
      l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
 -> Folded [Error () l])
-> (Synthesized
      (Auto TypeCheck)
      (Expression
         l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
    -> Atts
         (Synthesized TypeCheck)
         (Expression
            l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
-> Synthesized
     (Auto TypeCheck)
     (Expression
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Folded [Error () l]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Synthesized
  (Auto TypeCheck)
  (Expression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts
     (Synthesized (Auto TypeCheck))
     (Expression
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
Synthesized
  (Auto TypeCheck)
  (Expression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts
     (Synthesized TypeCheck)
     (Expression
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn) [Synthesized (Auto TypeCheck) (Expression l l sem sem)]
[Synthesized
   (Auto TypeCheck)
   (Expression
      l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))]
parameters',
               $sel:inferredType:SynTCExp :: Type l
inferredType=
                   case Synthesized
  (Auto TypeCheck)
  (Designator
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts
     (Synthesized (Auto TypeCheck))
     (Designator
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto TypeCheck) (Designator l l sem sem)
Synthesized
  (Auto TypeCheck)
  (Designator
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
designator
                   of SynTCDes{$sel:designatorName:SynTCDes :: forall l. SynTCDes l -> Maybe (Maybe Ident, Ident)
designatorName= Just (Just Ident
"SYSTEM", Ident
name)}
                        | Just Type l
t <- Ident -> [Type l] -> Maybe (Type l)
forall {a} {a}. (Eq a, IsString a) => a -> [a] -> Maybe a
systemCallType Ident
name (SynTCExp l -> Type l
forall l. SynTCExp l -> Type l
inferredType (SynTCExp l -> Type l)
-> (Synthesized
      (Auto TypeCheck)
      (Expression
         l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
    -> SynTCExp l)
-> Synthesized
     (Auto TypeCheck)
     (Expression
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Type l
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Synthesized
  (Auto TypeCheck)
  (Expression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts
     (Synthesized (Auto TypeCheck))
     (Expression
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
Synthesized
  (Auto TypeCheck)
  (Expression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> SynTCExp l
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn (Synthesized
   (Auto TypeCheck)
   (Expression
      l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
 -> Type l)
-> [Synthesized
      (Auto TypeCheck)
      (Expression
         l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))]
-> [Type l]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Synthesized (Auto TypeCheck) (Expression l l sem sem)]
[Synthesized
   (Auto TypeCheck)
   (Expression
      l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))]
parameters') -> Type l
t
                      SynTCDes{$sel:designatorName:SynTCDes :: forall l. SynTCDes l -> Maybe (Maybe Ident, Ident)
designatorName= Maybe (Maybe Ident, Ident)
d, $sel:designatorType:SynTCDes :: forall l. SynTCDes l -> Type l
designatorType= Type l
t}
                        | ProcedureType Bool
_ [(Bool, Type l)]
_ (Just Type l
returnType) <- Type l -> Type l
forall l. Type l -> Type l
ultimate Type l
t -> Type l
returnType
                      Atts
  (Synthesized (Auto TypeCheck))
  (Designator
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
_ -> Type l
forall l. Type l
UnknownType}
     where systemCallType :: a -> [a] -> Maybe a
systemCallType a
"VAL" [a
t1, a
t2] = a -> Maybe a
forall a. a -> Maybe a
Just a
t1
           systemCallType a
_ [a]
_ = Maybe a
forall a. Maybe a
Nothing
   synthesis Auto TypeCheck
_ (LexicalPosition
pos, Expression
  l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))
_) Atts (Inherited (Auto TypeCheck)) (Expression l l sem sem)
_inheritance (AST.Not Synthesized (Auto TypeCheck) (Expression l l sem sem)
expr) =
      SynTCExp{$sel:errors:SynTCExp :: Folded [Error () l]
errors= LexicalPosition -> SynTCExp l -> Folded [Error () l]
forall l. LexicalPosition -> SynTCExp l -> Folded [Error () l]
booleanExpressionErrors LexicalPosition
pos (Synthesized
  (Auto TypeCheck)
  (Expression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts
     (Synthesized (Auto TypeCheck))
     (Expression
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto TypeCheck) (Expression l l sem sem)
Synthesized
  (Auto TypeCheck)
  (Expression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
expr),
               $sel:inferredType:SynTCExp :: Type l
inferredType= Ident -> Type l
forall l. Ident -> Type l
BuiltinType Ident
"BOOLEAN"}
  
instance Abstract.Wirthy l => SynthesizedField "inferredType" (Type l) (Auto TypeCheck) (AST.Value l l) Sem Placed where
   synthesizedField :: forall (sem :: * -> *).
(sem ~ Semantics (Auto TypeCheck)) =>
Proxy "inferredType"
-> Auto TypeCheck
-> Placed
     (Value
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts (Inherited (Auto TypeCheck)) (Value l l sem sem)
-> Value l l sem (Synthesized (Auto TypeCheck))
-> Type l
synthesizedField Proxy "inferredType"
_ Auto TypeCheck
_ (LexicalPosition
_, AST.Integer Integer
x) Atts (Inherited (Auto TypeCheck)) (Value l l sem sem)
_ Value l l sem (Synthesized (Auto TypeCheck))
_  = Int -> Type l
forall l. Int -> Type l
IntegerType (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
x)
   synthesizedField Proxy "inferredType"
_ Auto TypeCheck
_ (LexicalPosition
_, AST.Real Double
x) Atts (Inherited (Auto TypeCheck)) (Value l l sem sem)
_ Value l l sem (Synthesized (Auto TypeCheck))
_     = Ident -> Type l
forall l. Ident -> Type l
BuiltinType Ident
"REAL"
   synthesizedField Proxy "inferredType"
_ Auto TypeCheck
_ (LexicalPosition
_, AST.Boolean Bool
x) Atts (Inherited (Auto TypeCheck)) (Value l l sem sem)
_ Value l l sem (Synthesized (Auto TypeCheck))
_  = Ident -> Type l
forall l. Ident -> Type l
BuiltinType Ident
"BOOLEAN"
   synthesizedField Proxy "inferredType"
_ Auto TypeCheck
_ (LexicalPosition
_, AST.CharCode Int
x) Atts (Inherited (Auto TypeCheck)) (Value l l sem sem)
_ Value l l sem (Synthesized (Auto TypeCheck))
_ = Ident -> Type l
forall l. Ident -> Type l
BuiltinType Ident
"CHAR"
   synthesizedField Proxy "inferredType"
_ Auto TypeCheck
_ (LexicalPosition
_, AST.String Ident
x) Atts (Inherited (Auto TypeCheck)) (Value l l sem sem)
_ Value l l sem (Synthesized (Auto TypeCheck))
_   = Int -> Type l
forall l. Int -> Type l
StringType (Ident -> Int
Text.length Ident
x)
   synthesizedField Proxy "inferredType"
_ Auto TypeCheck
_ (LexicalPosition
_, Value l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))
AST.Nil) Atts (Inherited (Auto TypeCheck)) (Value l l sem sem)
_ Value l l sem (Synthesized (Auto TypeCheck))
_        = Type l
forall l. Type l
NilType
   synthesizedField Proxy "inferredType"
_ Auto TypeCheck
_ (LexicalPosition
_, AST.Builtin Ident
x) Atts (Inherited (Auto TypeCheck)) (Value l l sem sem)
_ Value l l sem (Synthesized (Auto TypeCheck))
_  = Ident -> Type l
forall l. Ident -> Type l
BuiltinType Ident
x

instance (Atts (Synthesized (Auto TypeCheck)) (Abstract.Expression l l Sem Sem) ~ SynTCExp l) =>
         SynthesizedField "errors" (Folded [Error () l]) (Auto TypeCheck) (AST.Element l l) Sem Placed where
   synthesizedField :: forall (sem :: * -> *).
(sem ~ Semantics (Auto TypeCheck)) =>
Proxy "errors"
-> Auto TypeCheck
-> Placed
     (Element
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts (Inherited (Auto TypeCheck)) (Element l l sem sem)
-> Element l l sem (Synthesized (Auto TypeCheck))
-> Folded [Error () l]
synthesizedField Proxy "errors"
_ Auto TypeCheck
_ (LexicalPosition
pos, Element
  l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))
_) Atts (Inherited (Auto TypeCheck)) (Element l l sem sem)
_inheritance (AST.Element Synthesized (Auto TypeCheck) (Expression l l sem sem)
expr) = LexicalPosition -> SynTCExp l -> Folded [Error () l]
forall l. LexicalPosition -> SynTCExp l -> Folded [Error () l]
integerExpressionErrors LexicalPosition
pos (Synthesized
  (Auto TypeCheck)
  (Expression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts
     (Synthesized (Auto TypeCheck))
     (Expression
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto TypeCheck) (Expression l l sem sem)
Synthesized
  (Auto TypeCheck)
  (Expression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
expr)
   synthesizedField Proxy "errors"
_ Auto TypeCheck
_ (LexicalPosition
pos, Element
  l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))
_) Atts (Inherited (Auto TypeCheck)) (Element l l sem sem)
_inheritance (AST.Range Synthesized (Auto TypeCheck) (Expression l l sem sem)
low Synthesized (Auto TypeCheck) (Expression l l sem sem)
high) = LexicalPosition -> SynTCExp l -> Folded [Error () l]
forall l. LexicalPosition -> SynTCExp l -> Folded [Error () l]
integerExpressionErrors LexicalPosition
pos (Synthesized
  (Auto TypeCheck)
  (Expression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts
     (Synthesized (Auto TypeCheck))
     (Expression
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto TypeCheck) (Expression l l sem sem)
Synthesized
  (Auto TypeCheck)
  (Expression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
high)
                                                                     Folded [Error () l] -> Folded [Error () l] -> Folded [Error () l]
forall a. Semigroup a => a -> a -> a
<> LexicalPosition -> SynTCExp l -> Folded [Error () l]
forall l. LexicalPosition -> SynTCExp l -> Folded [Error () l]
integerExpressionErrors LexicalPosition
pos (Synthesized
  (Auto TypeCheck)
  (Expression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts
     (Synthesized (Auto TypeCheck))
     (Expression
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto TypeCheck) (Expression l l sem sem)
Synthesized
  (Auto TypeCheck)
  (Expression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
low)

instance SynthesizedField "inferredType" (Type l) (Auto TypeCheck) (AST.Element l l) Sem Placed where
   synthesizedField :: forall (sem :: * -> *).
(sem ~ Semantics (Auto TypeCheck)) =>
Proxy "inferredType"
-> Auto TypeCheck
-> Placed
     (Element
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts (Inherited (Auto TypeCheck)) (Element l l sem sem)
-> Element l l sem (Synthesized (Auto TypeCheck))
-> Type l
synthesizedField Proxy "inferredType"
_ Auto TypeCheck
_ Placed
  (Element
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
_ Atts (Inherited (Auto TypeCheck)) (Element l l sem sem)
_ Element l l sem (Synthesized (Auto TypeCheck))
_ = Ident -> Type l
forall l. Ident -> Type l
BuiltinType Ident
"SET"

instance {-# overlaps #-} (Abstract.Nameable l, Abstract.Oberon l, Ord (Abstract.QualIdent l),
                           Show (Abstract.QualIdent l),
                           Atts (Inherited (Auto TypeCheck)) (Abstract.Designator l l Sem Sem) ~ InhTC l,
                           Atts (Synthesized (Auto TypeCheck)) (Abstract.Expression l l Sem Sem) ~ SynTCExp l,
                           Atts (Synthesized (Auto TypeCheck)) (Abstract.Designator l l Sem Sem) ~ SynTCDes l) =>
                          Synthesizer (Auto TypeCheck) (AST.Designator l l) Sem Placed where
   synthesis :: forall (sem :: * -> *).
(sem ~ Semantics (Auto TypeCheck)) =>
Auto TypeCheck
-> Placed
     (Designator
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts (Inherited (Auto TypeCheck)) (Designator l l sem sem)
-> Designator l l sem (Synthesized (Auto TypeCheck))
-> Atts (Synthesized (Auto TypeCheck)) (Designator l l sem sem)
synthesis Auto TypeCheck
_ (LexicalPosition
pos, AST.Variable QualIdent l
q) InhTC{Environment l
$sel:env:InhTC :: forall l. InhTC l -> Environment l
env :: Environment l
env} Designator l l sem (Synthesized (Auto TypeCheck))
_ =
      SynTCDes{$sel:errors:SynTCDes :: Folded [Error () l]
errors= case Maybe (Type l)
designatorType
                       of Maybe (Type l)
Nothing -> [Error () l] -> Folded [Error () l]
forall a. a -> Folded a
Folded [() -> LexicalPosition -> ErrorType l -> Error () l
forall m l. m -> LexicalPosition -> ErrorType l -> Error m l
Error () LexicalPosition
pos (QualIdent l -> ErrorType l
forall l. QualIdent l -> ErrorType l
UnknownName QualIdent l
q)]
                          Just{} -> Folded [Error () l]
forall a. Monoid a => a
mempty,
               $sel:designatorName:SynTCDes :: Maybe (Maybe Ident, Ident)
designatorName= (,) Maybe Ident
forall a. Maybe a
Nothing (Ident -> (Maybe Ident, Ident))
-> Maybe Ident -> Maybe (Maybe Ident, Ident)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QualIdent l -> Maybe Ident
forall l. Nameable l => QualIdent l -> Maybe Ident
Abstract.getNonQualIdentName QualIdent l
q
                               Maybe (Maybe Ident, Ident)
-> Maybe (Maybe Ident, Ident) -> Maybe (Maybe Ident, Ident)
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Ident -> Maybe Ident) -> (Ident, Ident) -> (Maybe Ident, Ident)
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Ident -> Maybe Ident
forall a. a -> Maybe a
Just ((Ident, Ident) -> (Maybe Ident, Ident))
-> Maybe (Ident, Ident) -> Maybe (Maybe Ident, Ident)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QualIdent l -> Maybe (Ident, Ident)
forall l. Oberon l => QualIdent l -> Maybe (Ident, Ident)
Abstract.getQualIdentNames QualIdent l
q,
               $sel:designatorType:SynTCDes :: Type l
designatorType= Type l -> Maybe (Type l) -> Type l
forall a. a -> Maybe a -> a
fromMaybe Type l
forall l. Type l
UnknownType Maybe (Type l)
designatorType}
      where designatorType :: Maybe (Type l)
designatorType = QualIdent l -> Environment l -> Maybe (Type l)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup QualIdent l
q Environment l
env
   synthesis Auto TypeCheck
_ (LexicalPosition
pos, AST.Field Sem
  (Designator
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
_record Ident
fieldName) InhTC{} (AST.Field Synthesized (Auto TypeCheck) (Designator l l sem sem)
record Ident
_fieldName) =
      SynTCDes{$sel:errors:SynTCDes :: Folded [Error () l]
errors= case Synthesized
  (Auto TypeCheck)
  (Designator
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts
     (Synthesized (Auto TypeCheck))
     (Designator
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto TypeCheck) (Designator l l sem sem)
Synthesized
  (Auto TypeCheck)
  (Designator
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
record
                       of SynTCDes{$sel:errors:SynTCDes :: forall l. SynTCDes l -> Folded [Error () l]
errors= Folded [],
                                   $sel:designatorType:SynTCDes :: forall l. SynTCDes l -> Type l
designatorType= Type l
t} ->
                             Folded [Error () l]
-> (Maybe (Type l) -> Folded [Error () l])
-> Maybe (Maybe (Type l))
-> Folded [Error () l]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Error () l] -> Folded [Error () l]
forall a. a -> Folded a
Folded [() -> LexicalPosition -> ErrorType l -> Error () l
forall m l. m -> LexicalPosition -> ErrorType l -> Error m l
Error () LexicalPosition
pos (Type l -> ErrorType l
forall l. Type l -> ErrorType l
NonRecordType Type l
t)])
                                   (Folded [Error () l]
-> (Type l -> Folded [Error () l])
-> Maybe (Type l)
-> Folded [Error () l]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Error () l] -> Folded [Error () l]
forall a. a -> Folded a
Folded [() -> LexicalPosition -> ErrorType l -> Error () l
forall m l. m -> LexicalPosition -> ErrorType l -> Error m l
Error () LexicalPosition
pos (Ident -> Type l -> ErrorType l
forall l. Ident -> Type l -> ErrorType l
UnknownField Ident
fieldName Type l
t)]) ((Type l -> Folded [Error () l])
 -> Maybe (Type l) -> Folded [Error () l])
-> (Type l -> Folded [Error () l])
-> Maybe (Type l)
-> Folded [Error () l]
forall a b. (a -> b) -> a -> b
$ Folded [Error () l] -> Type l -> Folded [Error () l]
forall a b. a -> b -> a
const Folded [Error () l]
forall a. Monoid a => a
mempty)
                                   (Bool -> Type l -> Maybe (Maybe (Type l))
access Bool
True Type l
t)
                          SynTCDes{$sel:errors:SynTCDes :: forall l. SynTCDes l -> Folded [Error () l]
errors= Folded [Error () l]
errors} -> Folded [Error () l]
errors,
               $sel:designatorName:SynTCDes :: Maybe (Maybe Ident, Ident)
designatorName= Maybe (Maybe Ident, Ident)
forall a. Maybe a
Nothing,
               $sel:designatorType:SynTCDes :: Type l
designatorType= Type l -> Maybe (Type l) -> Type l
forall a. a -> Maybe a -> a
fromMaybe Type l
forall l. Type l
UnknownType (Maybe (Type l) -> Maybe (Maybe (Type l)) -> Maybe (Type l)
forall a. a -> Maybe a -> a
fromMaybe Maybe (Type l)
forall a. Maybe a
Nothing (Maybe (Maybe (Type l)) -> Maybe (Type l))
-> Maybe (Maybe (Type l)) -> Maybe (Type l)
forall a b. (a -> b) -> a -> b
$ Bool -> Type l -> Maybe (Maybe (Type l))
access Bool
True
                                                      (Type l -> Maybe (Maybe (Type l)))
-> Type l -> Maybe (Maybe (Type l))
forall a b. (a -> b) -> a -> b
$ SynTCDes l -> Type l
forall l. SynTCDes l -> Type l
designatorType (SynTCDes l -> Type l) -> SynTCDes l -> Type l
forall a b. (a -> b) -> a -> b
$ Synthesized
  (Auto TypeCheck)
  (Designator
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts
     (Synthesized (Auto TypeCheck))
     (Designator
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto TypeCheck) (Designator l l sem sem)
Synthesized
  (Auto TypeCheck)
  (Designator
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
record)}
     where access :: Bool -> Type l -> Maybe (Maybe (Type l))
access Bool
_ (RecordType [QualIdent l]
_ Map Ident (Type l)
fields) = Maybe (Type l) -> Maybe (Maybe (Type l))
forall a. a -> Maybe a
Just (Ident -> Map Ident (Type l) -> Maybe (Type l)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Ident
fieldName Map Ident (Type l)
fields)
           access Bool
True (PointerType Type l
t) = Bool -> Type l -> Maybe (Maybe (Type l))
access Bool
False Type l
t
           access Bool
allowPtr (NominalType QualIdent l
_ (Just Type l
t)) = Bool -> Type l -> Maybe (Maybe (Type l))
access Bool
allowPtr Type l
t
           access Bool
allowPtr (ReceiverType Type l
t) = (Type l -> Type l
forall l. Type l -> Type l
receive (Type l -> Type l) -> Maybe (Type l) -> Maybe (Type l)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Maybe (Type l) -> Maybe (Type l))
-> Maybe (Maybe (Type l)) -> Maybe (Maybe (Type l))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> Type l -> Maybe (Maybe (Type l))
access Bool
allowPtr Type l
t
           access Bool
_ Type l
_ = Maybe (Maybe (Type l))
forall a. Maybe a
Nothing
           receive :: Type l -> Type l
receive (ProcedureType Bool
_ [(Bool, Type l)]
params Maybe (Type l)
result) = Bool -> [(Bool, Type l)] -> Maybe (Type l) -> Type l
forall l. Bool -> [(Bool, Type l)] -> Maybe (Type l) -> Type l
ProcedureType Bool
True [(Bool, Type l)]
params Maybe (Type l)
result
           receive Type l
t = Type l
t
   synthesis Auto TypeCheck
_ (LexicalPosition
pos, AST.Index Sem
  (Designator
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
_array Sem
  (Expression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
index ZipList
  (Sem
     (Expression
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
indexes) InhTC{} (AST.Index Synthesized (Auto TypeCheck) (Designator l l sem sem)
array Synthesized (Auto TypeCheck) (Expression l l sem sem)
_index ZipList (Synthesized (Auto TypeCheck) (Expression l l sem sem))
_indexes) =
      SynTCDes{$sel:errors:SynTCDes :: Folded [Error () l]
errors= case Synthesized
  (Auto TypeCheck)
  (Designator
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts
     (Synthesized (Auto TypeCheck))
     (Designator
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto TypeCheck) (Designator l l sem sem)
Synthesized
  (Auto TypeCheck)
  (Designator
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
array
                       of SynTCDes{$sel:errors:SynTCDes :: forall l. SynTCDes l -> Folded [Error () l]
errors= Folded [],
                                   $sel:designatorType:SynTCDes :: forall l. SynTCDes l -> Type l
designatorType= Type l
t} -> (Folded [Error () l] -> Folded [Error () l])
-> (Type l -> Folded [Error () l])
-> Either (Folded [Error () l]) (Type l)
-> Folded [Error () l]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Folded [Error () l] -> Folded [Error () l]
forall a. a -> a
id (Folded [Error () l] -> Type l -> Folded [Error () l]
forall a b. a -> b -> a
const Folded [Error () l]
forall a. Monoid a => a
mempty) (Bool -> Type l -> Either (Folded [Error () l]) (Type l)
access Bool
True Type l
t)
                          SynTCDes{$sel:errors:SynTCDes :: forall l. SynTCDes l -> Folded [Error () l]
errors= Folded [Error () l]
errors} -> Folded [Error () l]
errors,
               $sel:designatorName:SynTCDes :: Maybe (Maybe Ident, Ident)
designatorName= Maybe (Maybe Ident, Ident)
forall a. Maybe a
Nothing,
               $sel:designatorType:SynTCDes :: Type l
designatorType= (Folded [Error () l] -> Type l)
-> (Type l -> Type l)
-> Either (Folded [Error () l]) (Type l)
-> Type l
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Type l -> Folded [Error () l] -> Type l
forall a b. a -> b -> a
const Type l
forall l. Type l
UnknownType) Type l -> Type l
forall a. a -> a
id (Bool -> Type l -> Either (Folded [Error () l]) (Type l)
access Bool
True (Type l -> Either (Folded [Error () l]) (Type l))
-> Type l -> Either (Folded [Error () l]) (Type l)
forall a b. (a -> b) -> a -> b
$ SynTCDes l -> Type l
forall l. SynTCDes l -> Type l
designatorType (SynTCDes l -> Type l) -> SynTCDes l -> Type l
forall a b. (a -> b) -> a -> b
$ Synthesized
  (Auto TypeCheck)
  (Designator
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts
     (Synthesized (Auto TypeCheck))
     (Designator
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto TypeCheck) (Designator l l sem sem)
Synthesized
  (Auto TypeCheck)
  (Designator
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
array)}
      where access :: Bool -> Type l -> Either (Folded [Error () l]) (Type l)
access Bool
_ (ArrayType [Int]
dimensions Type l
t)
              | [Int] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
dimensions Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== ZipList
  (Sem
     (Expression
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
-> Int
forall a. ZipList a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ZipList
  (Sem
     (Expression
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
indexes Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 = Type l -> Either (Folded [Error () l]) (Type l)
forall a b. b -> Either a b
Right Type l
t
              | [Int] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
dimensions Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& ZipList
  (Sem
     (Expression
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
-> Int
forall a. ZipList a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ZipList
  (Sem
     (Expression
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
indexes Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Type l -> Either (Folded [Error () l]) (Type l)
forall a b. b -> Either a b
Right Type l
t
              | Bool
otherwise = Folded [Error () l] -> Either (Folded [Error () l]) (Type l)
forall a b. a -> Either a b
Left ([Error () l] -> Folded [Error () l]
forall a. a -> Folded a
Folded [() -> LexicalPosition -> ErrorType l -> Error () l
forall m l. m -> LexicalPosition -> ErrorType l -> Error m l
Error () LexicalPosition
pos
                                          (ErrorType l -> Error () l) -> ErrorType l -> Error () l
forall a b. (a -> b) -> a -> b
$ Int -> Int -> ErrorType l
forall l. Int -> Int -> ErrorType l
ExtraDimensionalIndex ([Int] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
dimensions) (Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ZipList
  (Sem
     (Expression
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
-> Int
forall a. ZipList a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ZipList
  (Sem
     (Expression
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
indexes)])
            access Bool
allowPtr (NominalType QualIdent l
_ (Just Type l
t)) = Bool -> Type l -> Either (Folded [Error () l]) (Type l)
access Bool
allowPtr Type l
t
            access Bool
allowPtr (ReceiverType Type l
t) = Bool -> Type l -> Either (Folded [Error () l]) (Type l)
access Bool
allowPtr Type l
t
            access Bool
True (PointerType Type l
t) = Bool -> Type l -> Either (Folded [Error () l]) (Type l)
access Bool
False Type l
t
            access Bool
_ Type l
t = Folded [Error () l] -> Either (Folded [Error () l]) (Type l)
forall a b. a -> Either a b
Left ([Error () l] -> Folded [Error () l]
forall a. a -> Folded a
Folded [() -> LexicalPosition -> ErrorType l -> Error () l
forall m l. m -> LexicalPosition -> ErrorType l -> Error m l
Error () LexicalPosition
pos (Type l -> ErrorType l
forall l. Type l -> ErrorType l
NonArrayType Type l
t)])
   synthesis Auto TypeCheck
_ (LexicalPosition
pos, AST.TypeGuard Sem
  (Designator
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
_designator QualIdent l
q) InhTC{Environment l
$sel:env:InhTC :: forall l. InhTC l -> Environment l
env :: Environment l
env} (AST.TypeGuard Synthesized (Auto TypeCheck) (Designator l l sem sem)
designator QualIdent l
_q) =
      SynTCDes{$sel:errors:SynTCDes :: Folded [Error () l]
errors= case (Synthesized
  (Auto TypeCheck)
  (Designator
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts
     (Synthesized (Auto TypeCheck))
     (Designator
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto TypeCheck) (Designator l l sem sem)
Synthesized
  (Auto TypeCheck)
  (Designator
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
designator, Maybe (Type l)
targetType)
                                 of (SynTCDes{$sel:errors:SynTCDes :: forall l. SynTCDes l -> Folded [Error () l]
errors= Folded [],
                                              $sel:designatorType:SynTCDes :: forall l. SynTCDes l -> Type l
designatorType= Type l
t}, 
                                     Just Type l
t') -> LexicalPosition -> Type l -> Type l -> Folded [Error () l]
forall l.
(Nameable l, Eq (QualIdent l)) =>
LexicalPosition -> Type l -> Type l -> Folded [Error () l]
assignmentCompatible LexicalPosition
pos Type l
t Type l
t'
                                    (SynTCDes{$sel:errors:SynTCDes :: forall l. SynTCDes l -> Folded [Error () l]
errors= Folded [Error () l]
errors}, 
                                     Maybe (Type l)
Nothing) -> [Error () l] -> Folded [Error () l]
forall a. a -> Folded a
Folded (() -> LexicalPosition -> ErrorType l -> Error () l
forall m l. m -> LexicalPosition -> ErrorType l -> Error m l
Error () LexicalPosition
pos (QualIdent l -> ErrorType l
forall l. QualIdent l -> ErrorType l
UnknownName QualIdent l
q) Error () l -> [Error () l] -> [Error () l]
forall a. a -> [a] -> [a]
: Folded [Error () l] -> [Error () l]
forall a. Folded a -> a
getFolded Folded [Error () l]
errors)
                                    (SynTCDes{$sel:errors:SynTCDes :: forall l. SynTCDes l -> Folded [Error () l]
errors= Folded [Error () l]
errors}, Maybe (Type l)
_) -> Folded [Error () l]
errors,
               $sel:designatorName:SynTCDes :: Maybe (Maybe Ident, Ident)
designatorName= Maybe (Maybe Ident, Ident)
forall a. Maybe a
Nothing,
               $sel:designatorType:SynTCDes :: Type l
designatorType= Type l -> Maybe (Type l) -> Type l
forall a. a -> Maybe a -> a
fromMaybe Type l
forall l. Type l
UnknownType Maybe (Type l)
targetType}
      where targetType :: Maybe (Type l)
targetType = QualIdent l -> Environment l -> Maybe (Type l)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup QualIdent l
q Environment l
env
   synthesis Auto TypeCheck
_ (LexicalPosition
pos, Designator
  l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))
_) InhTC{} (AST.Dereference Synthesized (Auto TypeCheck) (Designator l l sem sem)
pointer) =
      SynTCDes{$sel:errors:SynTCDes :: Folded [Error () l]
errors= case Synthesized
  (Auto TypeCheck)
  (Designator
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts
     (Synthesized (Auto TypeCheck))
     (Designator
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto TypeCheck) (Designator l l sem sem)
Synthesized
  (Auto TypeCheck)
  (Designator
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
pointer
                       of SynTCDes{$sel:errors:SynTCDes :: forall l. SynTCDes l -> Folded [Error () l]
errors= Folded [],
                                   $sel:designatorType:SynTCDes :: forall l. SynTCDes l -> Type l
designatorType= Type l
t}
                             | PointerType{} <- Type l
t -> Folded [Error () l]
forall a. Monoid a => a
mempty
                             | NominalType QualIdent l
_ (Just PointerType{}) <- Type l
t -> Folded [Error () l]
forall a. Monoid a => a
mempty
                             | ProcedureType Bool
True [(Bool, Type l)]
_ Maybe (Type l)
_ <- Type l
t -> Folded [Error () l]
forall a. Monoid a => a
mempty
                             | Bool
otherwise -> [Error () l] -> Folded [Error () l]
forall a. a -> Folded a
Folded [() -> LexicalPosition -> ErrorType l -> Error () l
forall m l. m -> LexicalPosition -> ErrorType l -> Error m l
Error () LexicalPosition
pos (Type l -> ErrorType l
forall l. Type l -> ErrorType l
NonPointerType Type l
t)]
                          SynTCDes{$sel:errors:SynTCDes :: forall l. SynTCDes l -> Folded [Error () l]
errors= Folded [Error () l]
es} -> Folded [Error () l]
es,
               $sel:designatorName:SynTCDes :: Maybe (Maybe Ident, Ident)
designatorName= Maybe (Maybe Ident, Ident)
forall a. Maybe a
Nothing,
               $sel:designatorType:SynTCDes :: Type l
designatorType= case SynTCDes l -> Type l
forall l. SynTCDes l -> Type l
designatorType (Synthesized
  (Auto TypeCheck)
  (Designator
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts
     (Synthesized (Auto TypeCheck))
     (Designator
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto TypeCheck) (Designator l l sem sem)
Synthesized
  (Auto TypeCheck)
  (Designator
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
pointer)
                               of NominalType QualIdent l
_ (Just (PointerType Type l
t)) -> Type l
t
                                  ProcedureType Bool
True [(Bool, Type l)]
params Maybe (Type l)
result -> Bool -> [(Bool, Type l)] -> Maybe (Type l) -> Type l
forall l. Bool -> [(Bool, Type l)] -> Maybe (Type l) -> Type l
ProcedureType Bool
False [(Bool, Type l)]
params Maybe (Type l)
result
                                  PointerType Type l
t -> Type l
t
                                  Type l
_ -> Type l
forall l. Type l
UnknownType}

binaryNumericOrSetSynthesis :: LexicalPosition -> Synthesized t a -> Synthesized t a -> SynTCExp l
binaryNumericOrSetSynthesis LexicalPosition
pos Synthesized t a
left Synthesized t a
right =
   SynTCExp{$sel:errors:SynTCExp :: Folded [Error () l]
errors= LexicalPosition -> SynTCExp l -> SynTCExp l -> Folded [Error () l]
forall l.
(Nameable l, Eq (QualIdent l)) =>
LexicalPosition -> SynTCExp l -> SynTCExp l -> Folded [Error () l]
binarySetOrNumericOperatorErrors LexicalPosition
pos (Synthesized t a -> Atts (Synthesized t) a
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized t a
left) (Synthesized t a -> Atts (Synthesized t) a
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized t a
right),
            $sel:inferredType:SynTCExp :: Type l
inferredType= SynTCExp l -> SynTCExp l -> Type l
forall l.
(Nameable l, Eq (QualIdent l)) =>
SynTCExp l -> SynTCExp l -> Type l
binaryNumericOperatorType (Synthesized t a -> Atts (Synthesized t) a
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized t a
left) (Synthesized t a -> Atts (Synthesized t) a
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized t a
right)}

binaryIntegerSynthesis :: LexicalPosition -> Synthesized t a -> Synthesized t a -> SynTCExp l
binaryIntegerSynthesis LexicalPosition
pos Synthesized t a
left Synthesized t a
right =
   SynTCExp{$sel:errors:SynTCExp :: Folded [Error () l]
errors= LexicalPosition -> SynTCExp l -> SynTCExp l -> Folded [Error () l]
forall l.
Nameable l =>
LexicalPosition -> SynTCExp l -> SynTCExp l -> Folded [Error () l]
binaryIntegerOperatorErrors LexicalPosition
pos (Synthesized t a -> Atts (Synthesized t) a
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized t a
left) (Synthesized t a -> Atts (Synthesized t) a
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized t a
right),
            $sel:inferredType:SynTCExp :: Type l
inferredType= SynTCExp l -> SynTCExp l -> Type l
forall l.
(Nameable l, Eq (QualIdent l)) =>
SynTCExp l -> SynTCExp l -> Type l
binaryNumericOperatorType (Synthesized t a -> Atts (Synthesized t) a
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized t a
left) (Synthesized t a -> Atts (Synthesized t) a
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized t a
right)}

binaryBooleanSynthesis :: LexicalPosition -> Synthesized t a -> Synthesized t a -> SynTCExp l
binaryBooleanSynthesis LexicalPosition
pos Synthesized t a
left Synthesized t a
right =
   SynTCExp{$sel:errors:SynTCExp :: Folded [Error () l]
errors= LexicalPosition -> SynTCExp l -> SynTCExp l -> Folded [Error () l]
forall l.
(Nameable l, Eq (QualIdent l)) =>
LexicalPosition -> SynTCExp l -> SynTCExp l -> Folded [Error () l]
binaryBooleanOperatorErrors LexicalPosition
pos (Synthesized t a -> Atts (Synthesized t) a
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized t a
left) (Synthesized t a -> Atts (Synthesized t) a
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized t a
right),
            $sel:inferredType:SynTCExp :: Type l
inferredType= Ident -> Type l
forall l. Ident -> Type l
BuiltinType Ident
"BOOLEAN"}

unaryNumericOrSetOperatorErrors :: forall l. Abstract.Nameable l => LexicalPosition -> SynTCExp l -> Folded [Error () l]
unaryNumericOrSetOperatorErrors :: forall l.
Nameable l =>
LexicalPosition -> SynTCExp l -> Folded [Error () l]
unaryNumericOrSetOperatorErrors LexicalPosition
pos SynTCExp{$sel:errors:SynTCExp :: forall l. SynTCExp l -> Folded [Error () l]
errors= Folded [], $sel:inferredType:SynTCExp :: forall l. SynTCExp l -> Type l
inferredType= Type l
t}
   | IntegerType{} <- Type l
t = Folded [Error () l]
forall a. Monoid a => a
mempty
   | BuiltinType Ident
name <- Type l
t, Ident -> Bool
isNumerical Ident
name Bool -> Bool -> Bool
|| Ident
name Ident -> Ident -> Bool
forall a. Eq a => a -> a -> Bool
== Ident
"SET" = Folded [Error () l]
forall a. Monoid a => a
mempty
   | Bool
otherwise = [Error () l] -> Folded [Error () l]
forall a. a -> Folded a
Folded [() -> LexicalPosition -> ErrorType l -> Error () l
forall m l. m -> LexicalPosition -> ErrorType l -> Error m l
Error () LexicalPosition
pos (Type l -> ErrorType l
forall l. Type l -> ErrorType l
NonNumericType Type l
t)]
unaryNumericOrSetOperatorErrors LexicalPosition
_ SynTCExp{$sel:errors:SynTCExp :: forall l. SynTCExp l -> Folded [Error () l]
errors= Folded [Error () l]
errs} = Folded [Error () l]
errs

unaryNumericOrSetOperatorType :: (Int -> Int) -> SynTCExp l -> Type l
unaryNumericOrSetOperatorType :: forall l. (Int -> Int) -> SynTCExp l -> Type l
unaryNumericOrSetOperatorType Int -> Int
f SynTCExp{$sel:inferredType:SynTCExp :: forall l. SynTCExp l -> Type l
inferredType= IntegerType Int
x} = Int -> Type l
forall l. Int -> Type l
IntegerType (Int -> Int
f Int
x)
unaryNumericOrSetOperatorType Int -> Int
_ SynTCExp{$sel:inferredType:SynTCExp :: forall l. SynTCExp l -> Type l
inferredType= Type l
t} = Type l
t

binarySetOrNumericOperatorErrors :: forall l. (Abstract.Nameable l, Eq (Abstract.QualIdent l))
                                 => LexicalPosition -> SynTCExp l -> SynTCExp l -> Folded [Error () l]
binarySetOrNumericOperatorErrors :: forall l.
(Nameable l, Eq (QualIdent l)) =>
LexicalPosition -> SynTCExp l -> SynTCExp l -> Folded [Error () l]
binarySetOrNumericOperatorErrors LexicalPosition
_
  SynTCExp{$sel:errors:SynTCExp :: forall l. SynTCExp l -> Folded [Error () l]
errors= Folded [], $sel:inferredType:SynTCExp :: forall l. SynTCExp l -> Type l
inferredType= BuiltinType Ident
name1}
  SynTCExp{$sel:errors:SynTCExp :: forall l. SynTCExp l -> Folded [Error () l]
errors= Folded [], $sel:inferredType:SynTCExp :: forall l. SynTCExp l -> Type l
inferredType= BuiltinType Ident
name2}
  | Ident -> Bool
isNumerical Ident
name1 Bool -> Bool -> Bool
&& Ident -> Bool
isNumerical Ident
name2 Bool -> Bool -> Bool
|| Ident
name1 Ident -> Ident -> Bool
forall a. Eq a => a -> a -> Bool
== Ident
"SET" Bool -> Bool -> Bool
&& Ident
name2 Ident -> Ident -> Bool
forall a. Eq a => a -> a -> Bool
== Ident
"SET" = Folded [Error () l]
forall a. Monoid a => a
mempty
binarySetOrNumericOperatorErrors LexicalPosition
_
  SynTCExp{$sel:errors:SynTCExp :: forall l. SynTCExp l -> Folded [Error () l]
errors= Folded [], $sel:inferredType:SynTCExp :: forall l. SynTCExp l -> Type l
inferredType= IntegerType{}}
  SynTCExp{$sel:errors:SynTCExp :: forall l. SynTCExp l -> Folded [Error () l]
errors= Folded [], $sel:inferredType:SynTCExp :: forall l. SynTCExp l -> Type l
inferredType= BuiltinType Ident
name}
  | Ident -> Bool
isNumerical Ident
name = Folded [Error () l]
forall a. Monoid a => a
mempty
binarySetOrNumericOperatorErrors LexicalPosition
_
  SynTCExp{$sel:errors:SynTCExp :: forall l. SynTCExp l -> Folded [Error () l]
errors= Folded [], $sel:inferredType:SynTCExp :: forall l. SynTCExp l -> Type l
inferredType= BuiltinType Ident
name}
  SynTCExp{$sel:errors:SynTCExp :: forall l. SynTCExp l -> Folded [Error () l]
errors= Folded [], $sel:inferredType:SynTCExp :: forall l. SynTCExp l -> Type l
inferredType= IntegerType{}}
  | Ident -> Bool
isNumerical Ident
name = Folded [Error () l]
forall a. Monoid a => a
mempty
binarySetOrNumericOperatorErrors LexicalPosition
_
  SynTCExp{$sel:errors:SynTCExp :: forall l. SynTCExp l -> Folded [Error () l]
errors= Folded [], $sel:inferredType:SynTCExp :: forall l. SynTCExp l -> Type l
inferredType= IntegerType{}}
  SynTCExp{$sel:errors:SynTCExp :: forall l. SynTCExp l -> Folded [Error () l]
errors= Folded [], $sel:inferredType:SynTCExp :: forall l. SynTCExp l -> Type l
inferredType= IntegerType{}} = Folded [Error () l]
forall a. Monoid a => a
mempty
binarySetOrNumericOperatorErrors LexicalPosition
pos SynTCExp{$sel:errors:SynTCExp :: forall l. SynTCExp l -> Folded [Error () l]
errors= Folded [], $sel:inferredType:SynTCExp :: forall l. SynTCExp l -> Type l
inferredType= Type l
t1}
                                     SynTCExp{$sel:errors:SynTCExp :: forall l. SynTCExp l -> Folded [Error () l]
errors= Folded [], $sel:inferredType:SynTCExp :: forall l. SynTCExp l -> Type l
inferredType= Type l
t2}
  | Type l
t1 Type l -> Type l -> Bool
forall a. Eq a => a -> a -> Bool
== Type l
t2 = [Error () l] -> Folded [Error () l]
forall a. a -> Folded a
Folded [() -> LexicalPosition -> ErrorType l -> Error () l
forall m l. m -> LexicalPosition -> ErrorType l -> Error m l
Error () LexicalPosition
pos (Type l -> ErrorType l
forall l. Type l -> ErrorType l
NonNumericType Type l
t1)]
  | Bool
otherwise = [Error () l] -> Folded [Error () l]
forall a. a -> Folded a
Folded [() -> LexicalPosition -> ErrorType l -> Error () l
forall m l. m -> LexicalPosition -> ErrorType l -> Error m l
Error () LexicalPosition
pos (Type l -> Type l -> ErrorType l
forall l. Type l -> Type l -> ErrorType l
TypeMismatch Type l
t1 Type l
t2)]
binarySetOrNumericOperatorErrors LexicalPosition
_ SynTCExp{$sel:errors:SynTCExp :: forall l. SynTCExp l -> Folded [Error () l]
errors= Folded [Error () l]
errs1} SynTCExp{$sel:errors:SynTCExp :: forall l. SynTCExp l -> Folded [Error () l]
errors= Folded [Error () l]
errs2} = Folded [Error () l]
errs1 Folded [Error () l] -> Folded [Error () l] -> Folded [Error () l]
forall a. Semigroup a => a -> a -> a
<> Folded [Error () l]
errs2

binaryNumericOperatorType :: (Abstract.Nameable l, Eq (Abstract.QualIdent l)) => SynTCExp l -> SynTCExp l -> Type l
binaryNumericOperatorType :: forall l.
(Nameable l, Eq (QualIdent l)) =>
SynTCExp l -> SynTCExp l -> Type l
binaryNumericOperatorType SynTCExp{$sel:inferredType:SynTCExp :: forall l. SynTCExp l -> Type l
inferredType= Type l
t1} SynTCExp{$sel:inferredType:SynTCExp :: forall l. SynTCExp l -> Type l
inferredType= Type l
t2}
  | Type l
t1 Type l -> Type l -> Bool
forall a. Eq a => a -> a -> Bool
== Type l
t2 = Type l
t1
  | IntegerType{} <- Type l
t1 = Type l
t2
  | IntegerType{} <- Type l
t2 = Type l
t1
  | BuiltinType Ident
name1 <- Type l
t1, BuiltinType Ident
name2 <- Type l
t2,
    Just Int
index1 <- Ident -> [Ident] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
List.elemIndex Ident
name1 [Ident]
numericTypeNames,
    Just Int
index2 <- Ident -> [Ident] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
List.elemIndex Ident
name2 [Ident]
numericTypeNames = Ident -> Type l
forall l. Ident -> Type l
BuiltinType ([Ident]
numericTypeNames [Ident] -> Int -> Ident
forall a. HasCallStack => [a] -> Int -> a
!! Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
index1 Int
index2)
  | Bool
otherwise = Type l
t1

binaryIntegerOperatorErrors :: Abstract.Nameable l =>
                               LexicalPosition ->  SynTCExp l -> SynTCExp l -> Folded [Error () l]
binaryIntegerOperatorErrors :: forall l.
Nameable l =>
LexicalPosition -> SynTCExp l -> SynTCExp l -> Folded [Error () l]
binaryIntegerOperatorErrors LexicalPosition
pos SynTCExp l
syn1 SynTCExp l
syn2 = LexicalPosition -> SynTCExp l -> Folded [Error () l]
forall l. LexicalPosition -> SynTCExp l -> Folded [Error () l]
integerExpressionErrors LexicalPosition
pos SynTCExp l
syn1 Folded [Error () l] -> Folded [Error () l] -> Folded [Error () l]
forall a. Semigroup a => a -> a -> a
<> LexicalPosition -> SynTCExp l -> Folded [Error () l]
forall l. LexicalPosition -> SynTCExp l -> Folded [Error () l]
integerExpressionErrors LexicalPosition
pos SynTCExp l
syn2

integerExpressionErrors :: forall l. LexicalPosition -> SynTCExp l -> Folded [Error () l]
integerExpressionErrors :: forall l. LexicalPosition -> SynTCExp l -> Folded [Error () l]
integerExpressionErrors LexicalPosition
pos SynTCExp{$sel:errors:SynTCExp :: forall l. SynTCExp l -> Folded [Error () l]
errors= Folded [], $sel:inferredType:SynTCExp :: forall l. SynTCExp l -> Type l
inferredType= Type l
t}
  | Type l -> Bool
forall {l}. Type l -> Bool
isIntegerType Type l
t = Folded [Error () l]
forall a. Monoid a => a
mempty
  | Bool
otherwise = [Error () l] -> Folded [Error () l]
forall a. a -> Folded a
Folded [() -> LexicalPosition -> ErrorType l -> Error () l
forall m l. m -> LexicalPosition -> ErrorType l -> Error m l
Error () LexicalPosition
pos (Type l -> ErrorType l
forall l. Type l -> ErrorType l
NonIntegerType Type l
t)]
integerExpressionErrors LexicalPosition
_ SynTCExp{$sel:errors:SynTCExp :: forall l. SynTCExp l -> Folded [Error () l]
errors= Folded [Error () l]
errs} = Folded [Error () l]
errs

isIntegerType :: Type l -> Bool
isIntegerType IntegerType{} = Bool
True
isIntegerType (BuiltinType Ident
"SHORTINT") = Bool
True
isIntegerType (BuiltinType Ident
"INTEGER") = Bool
True
isIntegerType (BuiltinType Ident
"LONGINT") = Bool
True
isIntegerType Type l
t = Bool
False

booleanExpressionErrors :: forall l. LexicalPosition -> SynTCExp l -> Folded [Error () l]
booleanExpressionErrors :: forall l. LexicalPosition -> SynTCExp l -> Folded [Error () l]
booleanExpressionErrors LexicalPosition
_ SynTCExp{$sel:errors:SynTCExp :: forall l. SynTCExp l -> Folded [Error () l]
errors= Folded [],
                                     $sel:inferredType:SynTCExp :: forall l. SynTCExp l -> Type l
inferredType= BuiltinType Ident
"BOOLEAN"} = Folded [Error () l]
forall a. Monoid a => a
mempty
booleanExpressionErrors LexicalPosition
pos SynTCExp{$sel:errors:SynTCExp :: forall l. SynTCExp l -> Folded [Error () l]
errors= Folded [], $sel:inferredType:SynTCExp :: forall l. SynTCExp l -> Type l
inferredType= Type l
t} = 
   [Error () l] -> Folded [Error () l]
forall a. a -> Folded a
Folded [() -> LexicalPosition -> ErrorType l -> Error () l
forall m l. m -> LexicalPosition -> ErrorType l -> Error m l
Error () LexicalPosition
pos (Type l -> ErrorType l
forall l. Type l -> ErrorType l
NonBooleanType Type l
t)]
booleanExpressionErrors LexicalPosition
_ SynTCExp{$sel:errors:SynTCExp :: forall l. SynTCExp l -> Folded [Error () l]
errors= Folded [Error () l]
errs} = Folded [Error () l]
errs

binaryBooleanOperatorErrors :: forall l. (Abstract.Nameable l, Eq (Abstract.QualIdent l))
                            => LexicalPosition -> SynTCExp l -> SynTCExp l -> Folded [Error () l]
binaryBooleanOperatorErrors :: forall l.
(Nameable l, Eq (QualIdent l)) =>
LexicalPosition -> SynTCExp l -> SynTCExp l -> Folded [Error () l]
binaryBooleanOperatorErrors LexicalPosition
_pos
  SynTCExp{$sel:errors:SynTCExp :: forall l. SynTCExp l -> Folded [Error () l]
errors= Folded [], $sel:inferredType:SynTCExp :: forall l. SynTCExp l -> Type l
inferredType= BuiltinType Ident
"BOOLEAN"}
  SynTCExp{$sel:errors:SynTCExp :: forall l. SynTCExp l -> Folded [Error () l]
errors= Folded [], $sel:inferredType:SynTCExp :: forall l. SynTCExp l -> Type l
inferredType= BuiltinType Ident
"BOOLEAN"} = Folded [Error () l]
forall a. Monoid a => a
mempty
binaryBooleanOperatorErrors LexicalPosition
pos
  SynTCExp{$sel:errors:SynTCExp :: forall l. SynTCExp l -> Folded [Error () l]
errors= Folded [], $sel:inferredType:SynTCExp :: forall l. SynTCExp l -> Type l
inferredType= Type l
t1}
  SynTCExp{$sel:errors:SynTCExp :: forall l. SynTCExp l -> Folded [Error () l]
errors= Folded [], $sel:inferredType:SynTCExp :: forall l. SynTCExp l -> Type l
inferredType= Type l
t2}
  | Type l
t1 Type l -> Type l -> Bool
forall a. Eq a => a -> a -> Bool
== Type l
t2 = [Error () l] -> Folded [Error () l]
forall a. a -> Folded a
Folded [() -> LexicalPosition -> ErrorType l -> Error () l
forall m l. m -> LexicalPosition -> ErrorType l -> Error m l
Error () LexicalPosition
pos (Type l -> ErrorType l
forall l. Type l -> ErrorType l
NonBooleanType Type l
t1)]
  | Bool
otherwise = [Error () l] -> Folded [Error () l]
forall a. a -> Folded a
Folded [() -> LexicalPosition -> ErrorType l -> Error () l
forall m l. m -> LexicalPosition -> ErrorType l -> Error m l
Error () LexicalPosition
pos (Type l -> Type l -> ErrorType l
forall l. Type l -> Type l -> ErrorType l
TypeMismatch Type l
t1 Type l
t2)]
binaryBooleanOperatorErrors LexicalPosition
_ SynTCExp{$sel:errors:SynTCExp :: forall l. SynTCExp l -> Folded [Error () l]
errors= Folded [Error () l]
errs1} SynTCExp{$sel:errors:SynTCExp :: forall l. SynTCExp l -> Folded [Error () l]
errors= Folded [Error () l]
errs2} = Folded [Error () l]
errs1 Folded [Error () l] -> Folded [Error () l] -> Folded [Error () l]
forall a. Semigroup a => a -> a -> a
<> Folded [Error () l]
errs2

parameterCompatible :: forall l. (Abstract.Nameable l, Eq (Abstract.QualIdent l))
                    => LexicalPosition -> (Bool, Type l) -> Type l -> Folded [Error () l]
parameterCompatible :: forall l.
(Nameable l, Eq (QualIdent l)) =>
LexicalPosition -> (Bool, Type l) -> Type l -> Folded [Error () l]
parameterCompatible LexicalPosition
_ (Bool
_, expected :: Type l
expected@(ArrayType [] Type l
_)) Type l
actual
  | Type l -> Type l -> Bool
forall l. Eq (QualIdent l) => Type l -> Type l -> Bool
arrayCompatible Type l
expected Type l
actual = Folded [Error () l]
forall a. Monoid a => a
mempty
parameterCompatible LexicalPosition
pos (Bool
True, Type l
expected) Type l
actual
  | Type l
expected Type l -> Type l -> Bool
forall a. Eq a => a -> a -> Bool
== Type l
actual = Folded [Error () l]
forall a. Monoid a => a
mempty
  | Bool
otherwise = [Error () l] -> Folded [Error () l]
forall a. a -> Folded a
Folded [() -> LexicalPosition -> ErrorType l -> Error () l
forall m l. m -> LexicalPosition -> ErrorType l -> Error m l
Error () LexicalPosition
pos (Type l -> Type l -> ErrorType l
forall l. Type l -> Type l -> ErrorType l
UnequalTypes Type l
expected Type l
actual)]
parameterCompatible LexicalPosition
pos (Bool
False, Type l
expected) Type l
actual
  | BuiltinType Ident
"ARRAY" <- Type l
expected, ArrayType{} <- Type l
actual = Folded [Error () l]
forall a. Monoid a => a
mempty
  | Bool
otherwise = LexicalPosition -> Type l -> Type l -> Folded [Error () l]
forall l.
(Nameable l, Eq (QualIdent l)) =>
LexicalPosition -> Type l -> Type l -> Folded [Error () l]
assignmentCompatible LexicalPosition
pos Type l
expected Type l
actual

assignmentCompatibleIn :: forall l. (Abstract.Nameable l, Eq (Abstract.QualIdent l))
                       => InhTCExp l -> LexicalPosition -> Type l -> Folded [Error () l]
assignmentCompatibleIn :: forall l.
(Nameable l, Eq (QualIdent l)) =>
InhTCExp l -> LexicalPosition -> Type l -> Folded [Error () l]
assignmentCompatibleIn InhTCExp{Type l
$sel:expectedType:InhTCExp :: forall l. InhTCExp l -> Type l
expectedType :: Type l
expectedType} LexicalPosition
pos = LexicalPosition -> Type l -> Type l -> Folded [Error () l]
forall l.
(Nameable l, Eq (QualIdent l)) =>
LexicalPosition -> Type l -> Type l -> Folded [Error () l]
assignmentCompatible LexicalPosition
pos Type l
expectedType

assignmentCompatible :: forall l. (Abstract.Nameable l, Eq (Abstract.QualIdent l))
                     => LexicalPosition -> Type l -> Type l -> Folded [Error () l]
assignmentCompatible :: forall l.
(Nameable l, Eq (QualIdent l)) =>
LexicalPosition -> Type l -> Type l -> Folded [Error () l]
assignmentCompatible LexicalPosition
pos Type l
expected Type l
actual
   | Type l
expected Type l -> Type l -> Bool
forall a. Eq a => a -> a -> Bool
== Type l
actual = Folded [Error () l]
forall a. Monoid a => a
mempty
   | BuiltinType Ident
name1 <- Type l
expected, BuiltinType Ident
name2 <- Type l
actual,
     Just Int
index1 <- Ident -> [Ident] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
List.elemIndex Ident
name1 [Ident]
numericTypeNames,
     Just Int
index2 <- Ident -> [Ident] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
List.elemIndex Ident
name2 [Ident]
numericTypeNames, 
     Int
index1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
index2 = Folded [Error () l]
forall a. Monoid a => a
mempty
   | BuiltinType Ident
name <- Type l
expected, IntegerType{} <- Type l
actual, Ident -> Bool
isNumerical Ident
name = Folded [Error () l]
forall a. Monoid a => a
mempty
   | BuiltinType Ident
"BASIC TYPE" <- Type l
expected, BuiltinType Ident
name <- Type l
actual,
     Ident
name Ident -> [Ident] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Ident
"BOOLEAN", Ident
"CHAR", Ident
"SHORTINT", Ident
"INTEGER", Ident
"LONGINT", Ident
"REAL", Ident
"LONGREAL", Ident
"SET"] = Folded [Error () l]
forall a. Monoid a => a
mempty
   | BuiltinType Ident
"POINTER" <- Type l
expected, PointerType{} <- Type l
actual = Folded [Error () l]
forall a. Monoid a => a
mempty
   | BuiltinType Ident
"POINTER" <- Type l
expected, NominalType QualIdent l
_ (Just Type l
t) <- Type l
actual =
       LexicalPosition -> Type l -> Type l -> Folded [Error () l]
forall l.
(Nameable l, Eq (QualIdent l)) =>
LexicalPosition -> Type l -> Type l -> Folded [Error () l]
assignmentCompatible LexicalPosition
pos Type l
expected Type l
t
   | BuiltinType Ident
"CHAR" <- Type l
expected, Type l
actual Type l -> Type l -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Type l
forall l. Int -> Type l
StringType Int
1 = Folded [Error () l]
forall a. Monoid a => a
mempty
   | ReceiverType Type l
t <- Type l
actual = LexicalPosition -> Type l -> Type l -> Folded [Error () l]
forall l.
(Nameable l, Eq (QualIdent l)) =>
LexicalPosition -> Type l -> Type l -> Folded [Error () l]
assignmentCompatible LexicalPosition
pos Type l
expected Type l
t
   | ReceiverType Type l
t <- Type l
expected = LexicalPosition -> Type l -> Type l -> Folded [Error () l]
forall l.
(Nameable l, Eq (QualIdent l)) =>
LexicalPosition -> Type l -> Type l -> Folded [Error () l]
assignmentCompatible LexicalPosition
pos Type l
t Type l
actual
   | Type l
NilType <- Type l
actual, PointerType{} <- Type l
expected = Folded [Error () l]
forall a. Monoid a => a
mempty
   | Type l
NilType <- Type l
actual, ProcedureType{} <- Type l
expected = Folded [Error () l]
forall a. Monoid a => a
mempty
   | Type l
NilType <- Type l
actual, NominalType QualIdent l
_ (Just Type l
t) <- Type l
expected = LexicalPosition -> Type l -> Type l -> Folded [Error () l]
forall l.
(Nameable l, Eq (QualIdent l)) =>
LexicalPosition -> Type l -> Type l -> Folded [Error () l]
assignmentCompatible LexicalPosition
pos Type l
t Type l
actual
--   | ArrayType [] (BuiltinType "CHAR") <- expected, StringType{} <- actual = mempty
   | ArrayType [Int
m] (BuiltinType Ident
"CHAR") <- Type l
expected, StringType Int
n <- Type l
actual =
       [Error () l] -> Folded [Error () l]
forall a. a -> Folded a
Folded (if Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n then [() -> LexicalPosition -> ErrorType l -> Error () l
forall m l. m -> LexicalPosition -> ErrorType l -> Error m l
Error () LexicalPosition
pos (Int -> Int -> ErrorType l
forall l. Int -> Int -> ErrorType l
TooSmallArrayType Int
m Int
n)] else [])
   | Type l -> Type l -> Bool
forall l. Eq (QualIdent l) => Type l -> Type l -> Bool
targetExtends Type l
actual Type l
expected = Folded [Error () l]
forall a. Monoid a => a
mempty
   | NominalType QualIdent l
_ (Just Type l
t) <- Type l
expected, ProcedureType{} <- Type l
actual = LexicalPosition -> Type l -> Type l -> Folded [Error () l]
forall l.
(Nameable l, Eq (QualIdent l)) =>
LexicalPosition -> Type l -> Type l -> Folded [Error () l]
assignmentCompatible LexicalPosition
pos Type l
t Type l
actual
   | Bool
otherwise = [Error () l] -> Folded [Error () l]
forall a. a -> Folded a
Folded [() -> LexicalPosition -> ErrorType l -> Error () l
forall m l. m -> LexicalPosition -> ErrorType l -> Error m l
Error () LexicalPosition
pos (Type l -> Type l -> ErrorType l
forall l. Type l -> Type l -> ErrorType l
IncompatibleTypes Type l
expected Type l
actual)]

arrayCompatible :: Type l -> Type l -> Bool
arrayCompatible (ArrayType [] Type l
t1) (ArrayType [Int]
_ Type l
t2) = Type l
t1 Type l -> Type l -> Bool
forall a. Eq a => a -> a -> Bool
== Type l
t2 Bool -> Bool -> Bool
|| Type l -> Type l -> Bool
arrayCompatible Type l
t1 Type l
t2
arrayCompatible (ArrayType [] (BuiltinType Ident
"CHAR")) StringType{} = Bool
True
arrayCompatible (NominalType QualIdent l
_ (Just Type l
t1)) Type l
t2 = Type l -> Type l -> Bool
arrayCompatible Type l
t1 Type l
t2
arrayCompatible Type l
t1 (NominalType QualIdent l
_ (Just Type l
t2)) = Type l -> Type l -> Bool
arrayCompatible Type l
t1 Type l
t2
arrayCompatible Type l
_ Type l
_ = Bool
False

extends, targetExtends :: Eq (Abstract.QualIdent l) => Type l -> Type l -> Bool
Type l
t1 extends :: forall l. Eq (QualIdent l) => Type l -> Type l -> Bool
`extends` Type l
t2 | Type l
t1 Type l -> Type l -> Bool
forall a. Eq a => a -> a -> Bool
== Type l
t2 = Bool
True
RecordType [QualIdent l]
ancestry Map Ident (Type l)
_ `extends` NominalType QualIdent l
q Maybe (Type l)
_ = QualIdent l
q QualIdent l -> [QualIdent l] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [QualIdent l]
ancestry
NominalType QualIdent l
_ (Just Type l
t1) `extends` Type l
t2 = Type l
t1 Type l -> Type l -> Bool
forall l. Eq (QualIdent l) => Type l -> Type l -> Bool
`extends` Type l
t2
Type l
t1 `extends` Type l
t2 = Bool
False -- error (show (t1, t2))

ultimate :: Type l -> Type l
ultimate :: forall l. Type l -> Type l
ultimate (NominalType QualIdent l
_ (Just Type l
t)) = Type l -> Type l
forall l. Type l -> Type l
ultimate Type l
t
ultimate Type l
t = Type l
t

isNumerical :: Ident -> Bool
isNumerical Ident
t = Ident
t Ident -> [Ident] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Ident]
numericTypeNames
numericTypeNames :: [Ident]
numericTypeNames = [Ident
"SHORTINT", Ident
"INTEGER", Ident
"LONGINT", Ident
"REAL", Ident
"LONGREAL"]

PointerType Type l
t1 targetExtends :: forall l. Eq (QualIdent l) => Type l -> Type l -> Bool
`targetExtends` PointerType Type l
t2 = Type l
t1 Type l -> Type l -> Bool
forall l. Eq (QualIdent l) => Type l -> Type l -> Bool
`extends` Type l
t2
NominalType QualIdent l
_ (Just Type l
t1) `targetExtends` Type l
t2 = Type l
t1 Type l -> Type l -> Bool
forall l. Eq (QualIdent l) => Type l -> Type l -> Bool
`targetExtends` Type l
t2
Type l
t1 `targetExtends` NominalType QualIdent l
_ (Just Type l
t2) = Type l
t1 Type l -> Type l -> Bool
forall l. Eq (QualIdent l) => Type l -> Type l -> Bool
`targetExtends` Type l
t2
Type l
t1 `targetExtends` Type l
t2 | Type l
t1 Type l -> Type l -> Bool
forall a. Eq a => a -> a -> Bool
== Type l
t2 = Bool
True
Type l
t1 `targetExtends` Type l
t2 = Bool
False

instance Transformation.Transformation (Auto TypeCheck) where
   type Domain (Auto TypeCheck) = Placed
   type Codomain (Auto TypeCheck) = Semantics (Auto TypeCheck)

instance AG.Revelation (Auto TypeCheck) where
   reveal :: forall x. Auto TypeCheck -> Domain (Auto TypeCheck) x -> x
reveal (Auto TypeCheck
TypeCheck) = (LexicalPosition, x) -> x
Domain (Auto TypeCheck) x -> x
forall a b. (a, b) -> b
snd

instance Ord (Abstract.QualIdent l) => Transformation.At (Auto TypeCheck) (Modules l Sem Sem) where
   $ :: Auto TypeCheck
-> Domain
     (Auto TypeCheck)
     (Modules
        l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Codomain
     (Auto TypeCheck)
     (Modules
        l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
($) = (forall a. (LexicalPosition, a) -> a)
-> Auto TypeCheck
-> (LexicalPosition,
    Modules
      l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Semantics
     (Auto TypeCheck)
     (Modules
        l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
forall (q :: * -> *) t x (g :: (* -> *) -> (* -> *) -> *)
       (p :: * -> *).
(q ~ Semantics t, x ~ g q q, Apply (g q), Attribution t g q p) =>
(forall a. p a -> a) -> t -> p x -> q x
AG.applyDefault (LexicalPosition, a) -> a
forall a. (LexicalPosition, a) -> a
forall a b. (a, b) -> b
snd

-- * Unsafe Rank2 AST instances

instance Rank2.Apply (AST.Module l l f') where
   AST.Module Ident
name1 [(Maybe Ident, Ident)]
imports1 (~>) p q (Block l l f' f')
body1 <*> :: forall (p :: * -> *) (q :: * -> *).
Module l l f' (p ~> q) -> Module l l f' p -> Module l l f' q
<*> ~(AST.Module Ident
name2 [(Maybe Ident, Ident)]
imports2 p (Block l l f' f')
body2) =
      Ident
-> [(Maybe Ident, Ident)] -> q (Block l l f' f') -> Module l l f' q
forall λ l (f' :: * -> *) (f :: * -> *).
Ident
-> [(Maybe Ident, Ident)] -> f (Block l l f' f') -> Module λ l f' f
AST.Module Ident
name1 [(Maybe Ident, Ident)]
imports1 ((~>) p q (Block l l f' f')
-> p (Block l l f' f') -> q (Block l l f' f')
forall {k} (p :: k -> *) (q :: k -> *) (a :: k).
Arrow p q a -> p a -> q a
Rank2.apply (~>) p q (Block l l f' f')
body1 p (Block l l f' f')
body2)

-- | Check if the given collection of modules is well typed and return all type errors found. The collection is a
-- 'Map' keyed by module name. The first argument's value is typically 'predefined' or 'predefined2'.
checkModules :: forall l. (Abstract.Oberon l, Abstract.Nameable l,
                           Ord (Abstract.QualIdent l), Show (Abstract.QualIdent l),
                           Atts (Inherited (Auto TypeCheck)) (Abstract.Block l l Sem Sem) ~ InhTC l,
                           Atts (Synthesized (Auto TypeCheck)) (Abstract.Block l l Sem Sem) ~ SynTCMod l,
                           Full.Functor (Auto TypeCheck) (Abstract.Block l l))
             => Environment l -> Map AST.Ident (Placed (AST.Module l l Placed Placed)) -> [Error AST.Ident l]
checkModules :: forall l.
(Oberon l, Nameable l, Ord (QualIdent l), Show (QualIdent l),
 Atts
   (Inherited (Auto TypeCheck))
   (Block
      l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
 ~ InhTC l,
 Atts
   (Synthesized (Auto TypeCheck))
   (Block
      l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
 ~ SynTCMod l,
 Functor (Auto TypeCheck) (Block l l)) =>
Environment l
-> Map Ident (Placed (Module l l Placed Placed)) -> [Error Ident l]
checkModules Map (QualIdent l) (Type l)
predef Map Ident (Placed (Module l l Placed Placed))
modules =
   Folded [Error Ident l] -> [Error Ident l]
forall a. Folded a -> a
getFolded ((Synthesized
  (Auto TypeCheck)
  (Modules
     l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts
     (Synthesized (Auto TypeCheck))
     (Modules
        l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn (Auto TypeCheck
-> Domain
     (Auto TypeCheck)
     (Modules
        l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Codomain
     (Auto TypeCheck)
     (Modules
        l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
forall t x. At t x => t -> Domain t x -> Codomain t x
Transformation.apply (TypeCheck -> Auto TypeCheck
forall t. t -> Auto t
Auto TypeCheck
TypeCheck) (Modules l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))
-> (LexicalPosition,
    Modules
      l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
forall {b}. b -> (LexicalPosition, b)
wrap (Modules
   l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))
 -> (LexicalPosition,
     Modules
       l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
-> Modules
     l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))
-> (LexicalPosition,
    Modules
      l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
forall a b. (a -> b) -> a -> b
$ TypeCheck -> Auto TypeCheck
forall t. t -> Auto t
Auto TypeCheck
TypeCheck Auto TypeCheck
-> Modules l (Domain (Auto TypeCheck)) (Domain (Auto TypeCheck))
-> Modules
     l (Codomain (Auto TypeCheck)) (Codomain (Auto TypeCheck))
forall t (g :: (* -> *) -> (* -> *) -> *).
Functor t g =>
t -> g (Domain t) (Domain t) -> g (Codomain t) (Codomain t)
Deep.<$> Map Ident (Placed (Module l l Placed Placed))
-> Modules l Placed Placed
forall l (f' :: * -> *) (f :: * -> *).
Map Ident (f (Module l l f' f')) -> Modules l f' f
Modules Map Ident (Placed (Module l l Placed Placed))
modules)
                           Semantics
  (Auto TypeCheck)
  (Modules
     l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Inherited
     (Auto TypeCheck)
     (Modules
        l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Synthesized
     (Auto TypeCheck)
     (Modules
        l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
forall {k} (p :: k -> *) (q :: k -> *) (a :: k).
Arrow p q a -> p a -> q a
`Rank2.apply`
                           Atts
  (Inherited (Auto TypeCheck))
  (Modules
     l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Inherited
     (Auto TypeCheck)
     (Modules
        l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
forall t a. Atts (Inherited t) a -> Inherited t a
Inherited (Map (QualIdent l) (Type l) -> InhTCRoot l
forall l. Environment l -> InhTCRoot l
InhTCRoot Map (QualIdent l) (Type l)
predef))).errors)
   where wrap :: b -> (LexicalPosition, b)
wrap = (,) (Int
0, [Lexeme] -> ParsedLexemes
Trailing [], Int
0)

predefined, predefined2 :: (Abstract.Wirthy l, Ord (Abstract.QualIdent l)) => Environment l
-- | The set of 'Predefined' types and procedures defined in the Oberon Language Report.
predefined :: forall l. (Wirthy l, Ord (QualIdent l)) => Environment l
predefined = [(QualIdent l, Type l)] -> Map (QualIdent l) (Type l)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(QualIdent l, Type l)] -> Map (QualIdent l) (Type l))
-> [(QualIdent l, Type l)] -> Map (QualIdent l) (Type l)
forall a b. (a -> b) -> a -> b
$ ((Ident, Type l) -> (QualIdent l, Type l))
-> [(Ident, Type l)] -> [(QualIdent l, Type l)]
forall a b. (a -> b) -> [a] -> [b]
map ((Ident -> QualIdent l) -> (Ident, Type l) -> (QualIdent l, Type l)
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Ident -> QualIdent l
forall l. Wirthy l => Ident -> QualIdent l
Abstract.nonQualIdent) ([(Ident, Type l)] -> [(QualIdent l, Type l)])
-> [(Ident, Type l)] -> [(QualIdent l, Type l)]
forall a b. (a -> b) -> a -> b
$
   [(Ident
"BOOLEAN", Ident -> Type l
forall l. Ident -> Type l
BuiltinType Ident
"BOOLEAN"),
    (Ident
"CHAR", Ident -> Type l
forall l. Ident -> Type l
BuiltinType Ident
"CHAR"),
    (Ident
"SHORTINT", Ident -> Type l
forall l. Ident -> Type l
BuiltinType Ident
"SHORTINT"),
    (Ident
"INTEGER", Ident -> Type l
forall l. Ident -> Type l
BuiltinType Ident
"INTEGER"),
    (Ident
"LONGINT", Ident -> Type l
forall l. Ident -> Type l
BuiltinType Ident
"LONGINT"),
    (Ident
"REAL", Ident -> Type l
forall l. Ident -> Type l
BuiltinType Ident
"REAL"),
    (Ident
"LONGREAL", Ident -> Type l
forall l. Ident -> Type l
BuiltinType Ident
"LONGREAL"),
    (Ident
"SET", Ident -> Type l
forall l. Ident -> Type l
BuiltinType Ident
"SET"),
    (Ident
"TRUE", Ident -> Type l
forall l. Ident -> Type l
BuiltinType Ident
"BOOLEAN"),
    (Ident
"FALSE", Ident -> Type l
forall l. Ident -> Type l
BuiltinType Ident
"BOOLEAN"),
    (Ident
"ABS", Bool -> [(Bool, Type l)] -> Maybe (Type l) -> Type l
forall l. Bool -> [(Bool, Type l)] -> Maybe (Type l) -> Type l
ProcedureType Bool
False [(Bool
False, Ident -> Type l
forall l. Ident -> Type l
BuiltinType Ident
"INTEGER")] (Maybe (Type l) -> Type l) -> Maybe (Type l) -> Type l
forall a b. (a -> b) -> a -> b
$ Type l -> Maybe (Type l)
forall a. a -> Maybe a
Just (Type l -> Maybe (Type l)) -> Type l -> Maybe (Type l)
forall a b. (a -> b) -> a -> b
$ Ident -> Type l
forall l. Ident -> Type l
BuiltinType Ident
"INTEGER"),
    (Ident
"ASH", Bool -> [(Bool, Type l)] -> Maybe (Type l) -> Type l
forall l. Bool -> [(Bool, Type l)] -> Maybe (Type l) -> Type l
ProcedureType Bool
False [(Bool
False, Ident -> Type l
forall l. Ident -> Type l
BuiltinType Ident
"INTEGER")] (Maybe (Type l) -> Type l) -> Maybe (Type l) -> Type l
forall a b. (a -> b) -> a -> b
$ Type l -> Maybe (Type l)
forall a. a -> Maybe a
Just (Type l -> Maybe (Type l)) -> Type l -> Maybe (Type l)
forall a b. (a -> b) -> a -> b
$ Ident -> Type l
forall l. Ident -> Type l
BuiltinType Ident
"INTEGER"),
    (Ident
"CAP", Bool -> [(Bool, Type l)] -> Maybe (Type l) -> Type l
forall l. Bool -> [(Bool, Type l)] -> Maybe (Type l) -> Type l
ProcedureType Bool
False [(Bool
False, Ident -> Type l
forall l. Ident -> Type l
BuiltinType Ident
"CHAR")] (Maybe (Type l) -> Type l) -> Maybe (Type l) -> Type l
forall a b. (a -> b) -> a -> b
$ Type l -> Maybe (Type l)
forall a. a -> Maybe a
Just (Type l -> Maybe (Type l)) -> Type l -> Maybe (Type l)
forall a b. (a -> b) -> a -> b
$ Ident -> Type l
forall l. Ident -> Type l
BuiltinType Ident
"CHAR"),
    (Ident
"LEN", Bool -> [(Bool, Type l)] -> Maybe (Type l) -> Type l
forall l. Bool -> [(Bool, Type l)] -> Maybe (Type l) -> Type l
ProcedureType Bool
False [(Bool
False, Ident -> Type l
forall l. Ident -> Type l
BuiltinType Ident
"ARRAY")] (Maybe (Type l) -> Type l) -> Maybe (Type l) -> Type l
forall a b. (a -> b) -> a -> b
$ Type l -> Maybe (Type l)
forall a. a -> Maybe a
Just (Type l -> Maybe (Type l)) -> Type l -> Maybe (Type l)
forall a b. (a -> b) -> a -> b
$ Ident -> Type l
forall l. Ident -> Type l
BuiltinType Ident
"LONGINT"),
    (Ident
"MAX", Bool -> [(Bool, Type l)] -> Maybe (Type l) -> Type l
forall l. Bool -> [(Bool, Type l)] -> Maybe (Type l) -> Type l
ProcedureType Bool
False [(Bool
False, Ident -> Type l
forall l. Ident -> Type l
BuiltinType Ident
"BASIC TYPE")] (Maybe (Type l) -> Type l) -> Maybe (Type l) -> Type l
forall a b. (a -> b) -> a -> b
$ Type l -> Maybe (Type l)
forall a. a -> Maybe a
Just Type l
forall l. Type l
UnknownType),
    (Ident
"MIN", Bool -> [(Bool, Type l)] -> Maybe (Type l) -> Type l
forall l. Bool -> [(Bool, Type l)] -> Maybe (Type l) -> Type l
ProcedureType Bool
False [(Bool
False, Ident -> Type l
forall l. Ident -> Type l
BuiltinType Ident
"BASIC TYPE")] (Maybe (Type l) -> Type l) -> Maybe (Type l) -> Type l
forall a b. (a -> b) -> a -> b
$ Type l -> Maybe (Type l)
forall a. a -> Maybe a
Just Type l
forall l. Type l
UnknownType),
    (Ident
"ODD", Bool -> [(Bool, Type l)] -> Maybe (Type l) -> Type l
forall l. Bool -> [(Bool, Type l)] -> Maybe (Type l) -> Type l
ProcedureType Bool
False [(Bool
False, Ident -> Type l
forall l. Ident -> Type l
BuiltinType Ident
"CHAR")] (Maybe (Type l) -> Type l) -> Maybe (Type l) -> Type l
forall a b. (a -> b) -> a -> b
$ Type l -> Maybe (Type l)
forall a. a -> Maybe a
Just (Type l -> Maybe (Type l)) -> Type l -> Maybe (Type l)
forall a b. (a -> b) -> a -> b
$ Ident -> Type l
forall l. Ident -> Type l
BuiltinType Ident
"BOOLEAN"),
    (Ident
"SIZE", Bool -> [(Bool, Type l)] -> Maybe (Type l) -> Type l
forall l. Bool -> [(Bool, Type l)] -> Maybe (Type l) -> Type l
ProcedureType Bool
False [(Bool
False, Ident -> Type l
forall l. Ident -> Type l
BuiltinType Ident
"CHAR")] (Maybe (Type l) -> Type l) -> Maybe (Type l) -> Type l
forall a b. (a -> b) -> a -> b
$ Type l -> Maybe (Type l)
forall a. a -> Maybe a
Just (Type l -> Maybe (Type l)) -> Type l -> Maybe (Type l)
forall a b. (a -> b) -> a -> b
$ Ident -> Type l
forall l. Ident -> Type l
BuiltinType Ident
"INTEGER"),
    (Ident
"ORD", Bool -> [(Bool, Type l)] -> Maybe (Type l) -> Type l
forall l. Bool -> [(Bool, Type l)] -> Maybe (Type l) -> Type l
ProcedureType Bool
False [(Bool
False, Ident -> Type l
forall l. Ident -> Type l
BuiltinType Ident
"CHAR")] (Maybe (Type l) -> Type l) -> Maybe (Type l) -> Type l
forall a b. (a -> b) -> a -> b
$ Type l -> Maybe (Type l)
forall a. a -> Maybe a
Just (Type l -> Maybe (Type l)) -> Type l -> Maybe (Type l)
forall a b. (a -> b) -> a -> b
$ Ident -> Type l
forall l. Ident -> Type l
BuiltinType Ident
"INTEGER"),
    (Ident
"CHR", Bool -> [(Bool, Type l)] -> Maybe (Type l) -> Type l
forall l. Bool -> [(Bool, Type l)] -> Maybe (Type l) -> Type l
ProcedureType Bool
False [(Bool
False, Ident -> Type l
forall l. Ident -> Type l
BuiltinType Ident
"LONGINT")] (Maybe (Type l) -> Type l) -> Maybe (Type l) -> Type l
forall a b. (a -> b) -> a -> b
$ Type l -> Maybe (Type l)
forall a. a -> Maybe a
Just (Type l -> Maybe (Type l)) -> Type l -> Maybe (Type l)
forall a b. (a -> b) -> a -> b
$ Ident -> Type l
forall l. Ident -> Type l
BuiltinType Ident
"CHAR"),
    (Ident
"SHORT", Bool -> [(Bool, Type l)] -> Maybe (Type l) -> Type l
forall l. Bool -> [(Bool, Type l)] -> Maybe (Type l) -> Type l
ProcedureType Bool
False [(Bool
False, Ident -> Type l
forall l. Ident -> Type l
BuiltinType Ident
"LONGINT")] (Maybe (Type l) -> Type l) -> Maybe (Type l) -> Type l
forall a b. (a -> b) -> a -> b
$ Type l -> Maybe (Type l)
forall a. a -> Maybe a
Just (Type l -> Maybe (Type l)) -> Type l -> Maybe (Type l)
forall a b. (a -> b) -> a -> b
$ Ident -> Type l
forall l. Ident -> Type l
BuiltinType Ident
"SHORTINT"),
    (Ident
"LONG", Bool -> [(Bool, Type l)] -> Maybe (Type l) -> Type l
forall l. Bool -> [(Bool, Type l)] -> Maybe (Type l) -> Type l
ProcedureType Bool
False [(Bool
False, Ident -> Type l
forall l. Ident -> Type l
BuiltinType Ident
"INTEGER")] (Maybe (Type l) -> Type l) -> Maybe (Type l) -> Type l
forall a b. (a -> b) -> a -> b
$ Type l -> Maybe (Type l)
forall a. a -> Maybe a
Just (Type l -> Maybe (Type l)) -> Type l -> Maybe (Type l)
forall a b. (a -> b) -> a -> b
$ Ident -> Type l
forall l. Ident -> Type l
BuiltinType Ident
"INTEGER"),
    (Ident
"ENTIER", Bool -> [(Bool, Type l)] -> Maybe (Type l) -> Type l
forall l. Bool -> [(Bool, Type l)] -> Maybe (Type l) -> Type l
ProcedureType Bool
False [(Bool
False, Ident -> Type l
forall l. Ident -> Type l
BuiltinType Ident
"REAL")] (Maybe (Type l) -> Type l) -> Maybe (Type l) -> Type l
forall a b. (a -> b) -> a -> b
$ Type l -> Maybe (Type l)
forall a. a -> Maybe a
Just (Type l -> Maybe (Type l)) -> Type l -> Maybe (Type l)
forall a b. (a -> b) -> a -> b
$ Ident -> Type l
forall l. Ident -> Type l
BuiltinType Ident
"INTEGER"),
    (Ident
"INC", Bool -> [(Bool, Type l)] -> Maybe (Type l) -> Type l
forall l. Bool -> [(Bool, Type l)] -> Maybe (Type l) -> Type l
ProcedureType Bool
False [(Bool
False, Ident -> Type l
forall l. Ident -> Type l
BuiltinType Ident
"LONGINT")] Maybe (Type l)
forall a. Maybe a
Nothing),
    (Ident
"DEC", Bool -> [(Bool, Type l)] -> Maybe (Type l) -> Type l
forall l. Bool -> [(Bool, Type l)] -> Maybe (Type l) -> Type l
ProcedureType Bool
False [(Bool
False, Ident -> Type l
forall l. Ident -> Type l
BuiltinType Ident
"LONGINT")] Maybe (Type l)
forall a. Maybe a
Nothing),
    (Ident
"INCL", Bool -> [(Bool, Type l)] -> Maybe (Type l) -> Type l
forall l. Bool -> [(Bool, Type l)] -> Maybe (Type l) -> Type l
ProcedureType Bool
False [(Bool
False, Ident -> Type l
forall l. Ident -> Type l
BuiltinType Ident
"SET"), (Bool
False, Ident -> Type l
forall l. Ident -> Type l
BuiltinType Ident
"INTEGER")] Maybe (Type l)
forall a. Maybe a
Nothing),
    (Ident
"EXCL", Bool -> [(Bool, Type l)] -> Maybe (Type l) -> Type l
forall l. Bool -> [(Bool, Type l)] -> Maybe (Type l) -> Type l
ProcedureType Bool
False [(Bool
False, Ident -> Type l
forall l. Ident -> Type l
BuiltinType Ident
"SET"), (Bool
False, Ident -> Type l
forall l. Ident -> Type l
BuiltinType Ident
"INTEGER")] Maybe (Type l)
forall a. Maybe a
Nothing),
    (Ident
"COPY", Bool -> [(Bool, Type l)] -> Maybe (Type l) -> Type l
forall l. Bool -> [(Bool, Type l)] -> Maybe (Type l) -> Type l
ProcedureType Bool
False [(Bool
False, Ident -> Type l
forall l. Ident -> Type l
BuiltinType Ident
"ARRAY"), (Bool
False, Ident -> Type l
forall l. Ident -> Type l
BuiltinType Ident
"ARRAY")] Maybe (Type l)
forall a. Maybe a
Nothing),
    (Ident
"NEW", Bool -> [(Bool, Type l)] -> Maybe (Type l) -> Type l
forall l. Bool -> [(Bool, Type l)] -> Maybe (Type l) -> Type l
ProcedureType Bool
False [(Bool
False, Ident -> Type l
forall l. Ident -> Type l
BuiltinType Ident
"POINTER")] Maybe (Type l)
forall a. Maybe a
Nothing),
    (Ident
"HALT", Bool -> [(Bool, Type l)] -> Maybe (Type l) -> Type l
forall l. Bool -> [(Bool, Type l)] -> Maybe (Type l) -> Type l
ProcedureType Bool
False [(Bool
False, Ident -> Type l
forall l. Ident -> Type l
BuiltinType Ident
"INTEGER")] Maybe (Type l)
forall a. Maybe a
Nothing)]

-- | The set of 'Predefined' types and procedures defined in the Oberon-2 Language Report.
predefined2 :: forall l. (Wirthy l, Ord (QualIdent l)) => Environment l
predefined2 = Map (QualIdent l) (Type l)
forall l. (Wirthy l, Ord (QualIdent l)) => Environment l
predefined Map (QualIdent l) (Type l)
-> Map (QualIdent l) (Type l) -> Map (QualIdent l) (Type l)
forall a. Semigroup a => a -> a -> a
<>
   [(QualIdent l, Type l)] -> Map (QualIdent l) (Type l)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ((Ident -> QualIdent l) -> (Ident, Type l) -> (QualIdent l, Type l)
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Ident -> QualIdent l
forall l. Wirthy l => Ident -> QualIdent l
Abstract.nonQualIdent ((Ident, Type l) -> (QualIdent l, Type l))
-> [(Ident, Type l)] -> [(QualIdent l, Type l)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                 [(Ident
"ASSERT", Bool -> [(Bool, Type l)] -> Maybe (Type l) -> Type l
forall l. Bool -> [(Bool, Type l)] -> Maybe (Type l) -> Type l
ProcedureType Bool
False [(Bool
False, Ident -> Type l
forall l. Ident -> Type l
BuiltinType Ident
"BOOLEAN"),
                                                  (Bool
False, Ident -> Type l
forall l. Ident -> Type l
BuiltinType Ident
"INTEGER")] Maybe (Type l)
forall a. Maybe a
Nothing)])