{-# LANGUAGE DataKinds, DeriveGeneric, DuplicateRecordFields, FlexibleContexts, FlexibleInstances,
             MultiParamTypeClasses, OverloadedStrings, ScopedTypeVariables,
             TemplateHaskell, 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 Language.Haskell.TH (appT, conT, varT, newName)

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{Type l -> [QualIdent l]
ancestry :: [Abstract.QualIdent 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)

type Error l = (AST.Ident, (Int, ParsedLexemes, Int), ErrorType l)

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

instance Show (Abstract.QualIdent l) => Show (Type l) where
  show :: Type l -> String
show (NominalType QualIdent l
q Maybe (Type l)
t) = String
"Nominal " String -> ShowS
forall a. [a] -> [a] -> [a]
++ QualIdent l -> String
forall a. Show a => a -> String
show QualIdent l
q String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Maybe (Type l) -> ShowS
forall a. Show a => a -> ShowS
shows Maybe (Type l)
t String
")"
  show (RecordType [QualIdent l]
ancestry Map Ident (Type l)
fields) = String
"RecordType " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [QualIdent l] -> String
forall a. Show a => a -> String
show [QualIdent l]
ancestry String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Ident] -> String
forall a. Show a => a -> String
show ((Ident, Type l) -> Ident
forall a b. (a, b) -> a
fst ((Ident, Type l) -> Ident) -> [(Ident, Type l)] -> [Ident]
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)
  show (ArrayType [Int]
dimensions Type l
itemType) = String
"ArrayType " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Int] -> String
forall a. Show a => a -> String
show [Int]
dimensions String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Type l -> ShowS
forall a. Show a => a -> ShowS
shows Type l
itemType String
")"
  show (PointerType Type l
targetType) = String
"PointerType " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Type l -> String
forall a. Show a => a -> String
show Type l
targetType
  show (ProcedureType Bool
_ [(Bool, Type l)]
parameters Maybe (Type l)
result) = String
"ProcedureType (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [(Bool, Type l)] -> String
forall a. Show a => a -> String
show [(Bool, Type l)]
parameters String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"): " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Maybe (Type l) -> String
forall a. Show a => a -> String
show Maybe (Type l)
result
  show (ReceiverType Type l
t) = String
"ReceiverType " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Type l -> String
forall a. Show a => a -> String
show Type l
t
  show (IntegerType Int
n) = String
"IntegerType " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n
  show (StringType Int
len) = String
"StringType " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
len
  show (BuiltinType Ident
name) = String
"BuiltinType " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Ident -> String
forall a. Show a => a -> String
show Ident
name
  show Type l
NilType = String
"NilType"
  show Type l
UnknownType = String
"UnknownType"

errorMessage :: (Abstract.Nameable l, Abstract.Oberon l, Show (Abstract.QualIdent l)) => ErrorType l -> String
errorMessage :: 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 :: 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 (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 (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 :: 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{InhTCRoot l -> Environment l
rootEnv :: Environment l}

data InhTC l = InhTC{InhTC l -> Environment l
env           :: Environment l,
                     InhTC l -> Ident
currentModule :: AST.Ident}
               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
$cto :: forall l x. Rep (InhTC l) x -> InhTC l
$cfrom :: forall l x. InhTC l -> Rep (InhTC l) x
Generic

data InhTCExp l = InhTCExp{InhTCExp l -> Environment l
env           :: Environment l,
                           InhTCExp l -> Ident
currentModule :: AST.Ident,
                           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
$cto :: forall l x. Rep (InhTCExp l) x -> InhTCExp l
$cfrom :: forall l x. InhTCExp l -> Rep (InhTCExp l) x
Generic

data InhTCDecl l = InhTCDecl{InhTCDecl l -> Environment l
env           :: Environment l,
                             InhTCDecl l -> Ident
currentModule :: AST.Ident,
                             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
$cto :: forall l x. Rep (InhTCDecl l) x -> InhTCDecl l
$cfrom :: forall l x. InhTCDecl l -> Rep (InhTCDecl l) x
Generic

data SynTC l = SynTC{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
$cto :: forall l x. Rep (SynTC l) x -> SynTC l
$cfrom :: forall l x. SynTC l -> Rep (SynTC l) x
Generic

data SynTCMod l = SynTCMod{SynTCMod l -> Folded [Error l]
errors :: Folded [Error l],
                           SynTCMod l -> Environment l
moduleEnv :: Environment 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
$cto :: forall l x. Rep (SynTCMod l) x -> SynTCMod l
$cfrom :: forall l x. SynTCMod l -> Rep (SynTCMod l) x
Generic

data SynTCType l = SynTCType{SynTCType l -> Folded [Error l]
errors :: Folded [Error l],
                             SynTCType l -> Maybe Ident
typeName   :: Maybe AST.Ident,
                             SynTCType l -> Type l
definedType :: Type 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
$cto :: forall l x. Rep (SynTCType l) x -> SynTCType l
$cfrom :: forall l x. SynTCType l -> Rep (SynTCType l) x
Generic

data SynTCFields l = SynTCFields{SynTCFields l -> Folded [Error l]
errors :: Folded [Error 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
$cto :: forall l x. Rep (SynTCFields l) x -> SynTCFields l
$cfrom :: forall l x. SynTCFields l -> Rep (SynTCFields l) x
Generic

data SynTCHead l = SynTCHead{SynTCHead l -> Folded [Error l]
errors :: Folded [Error l],
                             SynTCHead l -> Environment l
insideEnv :: Environment 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
$cto :: forall l x. Rep (SynTCHead l) x -> SynTCHead l
$cfrom :: forall l x. SynTCHead l -> Rep (SynTCHead l) x
Generic

data SynTCSig l = SynTCSig{SynTCSig l -> Folded [Error l]
errors :: Folded [Error l],
                           SynTCSig l -> Environment l
signatureEnv :: Environment 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
$cto :: forall l x. Rep (SynTCSig l) x -> SynTCSig l
$cfrom :: forall l x. SynTCSig l -> Rep (SynTCSig l) x
Generic

data SynTCSec l = SynTCSec{SynTCSec l -> Folded [Error l]
errors :: Folded [Error l],
                           SynTCSec l -> Environment l
sectionEnv :: Environment 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
$cto :: forall l x. Rep (SynTCSec l) x -> SynTCSec l
$cfrom :: forall l x. SynTCSec l -> Rep (SynTCSec l) x
Generic

data SynTCDes l = SynTCDes{SynTCDes l -> Folded [Error l]
errors :: Folded [Error l],
                           SynTCDes l -> Maybe (Maybe Ident, Ident)
designatorName   :: Maybe (Maybe Abstract.Ident, Abstract.Ident),
                           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
$cto :: forall l x. Rep (SynTCDes l) x -> SynTCDes l
$cfrom :: forall l x. SynTCDes l -> Rep (SynTCDes l) x
Generic

data SynTCExp l = SynTCExp{SynTCExp l -> Folded [Error l]
errors :: Folded [Error 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
$cto :: forall l x. Rep (SynTCExp l) x -> SynTCExp l
$cfrom :: forall l x. SynTCExp l -> Rep (SynTCExp l) x
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 :: 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 a k (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 (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 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 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 (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) <*> :: 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 (Auto TypeCheck)) (Modules l _ _) = InhTCRoot l
type instance Atts (Synthesized (Auto TypeCheck)) (Modules l _ _) = SynTC l
type instance Atts (Inherited (Auto TypeCheck)) (AST.Module l l _ _) = InhTC l
type instance Atts (Synthesized (Auto TypeCheck)) (AST.Module l l _ _) = SynTCMod l
type instance Atts (Inherited (Auto TypeCheck)) (AST.Declaration l l _ _) = InhTCDecl l
type instance Atts (Synthesized (Auto TypeCheck)) (AST.Declaration l l _ _) = SynTCMod l
type instance Atts (Inherited (Auto TypeCheck)) (AST.ProcedureHeading l l _ _) = InhTCDecl l
type instance Atts (Synthesized (Auto TypeCheck)) (AST.ProcedureHeading l l _ _) = SynTCHead l
type instance Atts (Inherited (Auto TypeCheck)) (AST.Block l l _ _) = InhTC l
type instance Atts (Synthesized (Auto TypeCheck)) (AST.Block l l _ _) = SynTCMod l
type instance Atts (Inherited (Auto TypeCheck)) (AST.FormalParameters l l _ _) = InhTC l
type instance Atts (Synthesized (Auto TypeCheck)) (AST.FormalParameters l l _ _) = SynTCSig l
type instance Atts (Inherited (Auto TypeCheck)) (AST.FPSection l l _ _) = InhTC l
type instance Atts (Synthesized (Auto TypeCheck)) (AST.FPSection l l _ _) = SynTCSec l
type instance Atts (Inherited (Auto TypeCheck)) (AST.Type l l _ _) = InhTC l
type instance Atts (Synthesized (Auto TypeCheck)) (AST.Type l l _ _) = SynTCType l
type instance Atts (Inherited (Auto TypeCheck)) (AST.FieldList l l _ _) = InhTC l
type instance Atts (Synthesized (Auto TypeCheck)) (AST.FieldList l l _ _) = SynTCFields l
type instance Atts (Inherited (Auto TypeCheck)) (AST.StatementSequence l l _ _) = InhTC l
type instance Atts (Synthesized (Auto TypeCheck)) (AST.StatementSequence l l _ _) = SynTC l
type instance Atts (Inherited (Auto TypeCheck)) (AST.Expression l l _ _) = InhTC l
type instance Atts (Synthesized (Auto TypeCheck)) (AST.Expression l l _ _) = SynTCExp l
type instance Atts (Inherited (Auto TypeCheck)) (AST.Element l l _ _) = InhTC l
type instance Atts (Synthesized (Auto TypeCheck)) (AST.Element l l _ _) = SynTCExp l
type instance Atts (Inherited (Auto TypeCheck)) (AST.Value l l _ _) = InhTC l
type instance Atts (Synthesized (Auto TypeCheck)) (AST.Value l l _ _) = SynTCExp l
type instance Atts (Inherited (Auto TypeCheck)) (AST.Designator l l _ _) = InhTC l
type instance Atts (Synthesized (Auto TypeCheck)) (AST.Designator l l _ _) = SynTCDes l
type instance Atts (Inherited (Auto TypeCheck)) (AST.Statement l l _ _) = InhTC l
type instance Atts (Synthesized (Auto TypeCheck)) (AST.Statement l l _ _) = SynTC l
type instance Atts (Inherited (Auto TypeCheck)) (AST.ConditionalBranch l l _ _) = InhTC l
type instance Atts (Synthesized (Auto TypeCheck)) (AST.ConditionalBranch l l _ _) = SynTC l
type instance Atts (Inherited (Auto TypeCheck)) (AST.Case l l _ _) = InhTCExp l
type instance Atts (Synthesized (Auto TypeCheck)) (AST.Case l l _ _) = SynTC l
type instance Atts (Inherited (Auto TypeCheck)) (AST.CaseLabels l l _ _) = InhTCExp l
type instance Atts (Synthesized (Auto TypeCheck)) (AST.CaseLabels l l _ _) = SynTC l
type instance Atts (Inherited (Auto TypeCheck)) (AST.WithAlternative l l _ _) = InhTC l
type instance Atts (Synthesized (Auto TypeCheck)) (AST.WithAlternative l l _ _) = SynTC l

-- * Rules

instance Ord (Abstract.QualIdent l) => Bequether (Auto TypeCheck) (Modules l) Sem Placed where
   bequest :: 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
_ ((Int, ParsedLexemes, Int)
_, 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 :: forall l. Environment l -> Ident -> InhTC l
InhTC{$sel:env:InhTC :: Environment l
env= InhTCRoot l -> Environment l
forall l. InhTCRoot l -> Environment l
rootEnv Atts (Inherited (Auto TypeCheck)) (Modules l sem sem)
InhTCRoot l
inheritance Environment l -> Environment l -> Environment l
forall a. Semigroup a => a -> a -> a
<> (Synthesized (Auto TypeCheck) (Module l l sem sem)
 -> Environment l)
-> Map Ident (Synthesized (Auto TypeCheck) (Module l l sem sem))
-> Environment l
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (SynTCMod l -> Environment l
forall l. SynTCMod l -> Environment l
moduleEnv (SynTCMod l -> Environment l)
-> (Synthesized (Auto TypeCheck) (Module l l sem sem)
    -> SynTCMod l)
-> Synthesized (Auto TypeCheck) (Module l l sem sem)
-> Environment l
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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,
                                                        $sel:currentModule:InhTC :: Ident
currentModule= Ident
name}
instance Ord (Abstract.QualIdent l) => Synthesizer (Auto TypeCheck) (Modules l) Sem Placed where
  synthesis :: 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) = SynTC :: forall l. Folded [Error l] -> SynTC l
SynTC{$sel:errors:SynTC :: Folded [Error l]
errors= (Synthesized (Auto TypeCheck) (Module l l sem sem)
 -> Folded [Error l])
-> Map Ident (Synthesized (Auto TypeCheck) (Module l l sem sem))
-> Folded [Error l]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\Synthesized (Auto TypeCheck) (Module l l sem sem)
m-> SynTCMod l -> Folded [Error l]
forall l. SynTCMod l -> Folded [Error l]
errors (Synthesized (Auto TypeCheck) (Module l l sem sem)
-> Atts (Synthesized (Auto TypeCheck)) (Module l l sem sem)
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized (Auto TypeCheck) (Module l l sem sem)
m :: SynTCMod l)) Map Ident (Synthesized (Auto TypeCheck) (Module l l sem sem))
ms}

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 :: 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
_ ((Int, ParsedLexemes, Int)
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
<$> (k -> k) -> Map k (Type l) -> Map k (Type l)
forall k1 k2 a. (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeysMonotonic k -> k
export (SynTCMod l -> Environment l
forall l. SynTCMod l -> Environment l
moduleEnv (SynTCMod l -> Environment l) -> SynTCMod l -> Environment 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 :: k -> k
export k
q
               | Just Ident
name <- QualIdent l -> Maybe Ident
forall l. Nameable l => QualIdent l -> Maybe Ident
Abstract.getNonQualIdentName k
QualIdent l
q = Ident -> Ident -> QualIdent l
forall l. Oberon l => Ident -> Ident -> QualIdent l
Abstract.qualIdent Ident
moduleName Ident
name
               | Bool
otherwise = k
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 (k -> k
export (k -> k) -> [k] -> [k]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [k]
[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.Declaration l l Sem Sem) ~ InhTCDecl 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,
          Atts (Synthesized (Auto TypeCheck)) (Abstract.Declaration l l Sem Sem) ~ SynTCMod l) =>
         Bequether (Auto TypeCheck) (AST.Declaration l l) Sem Placed where
   bequest :: 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
_ ((Int, ParsedLexemes, Int)
pos, AST.ProcedureDeclaration{})
           inheritance :: Atts (Inherited (Auto TypeCheck)) (Declaration l l sem sem)
inheritance@InhTCDecl{env= declEnv, currentModule= m} (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 :: forall l. Environment l -> Ident -> InhTC l
InhTC{$sel:env:InhTC :: Environment l
env= SynTCHead l -> Environment 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) Environment l -> Environment l -> Environment l
forall k a. Ord k => Map k a -> Map k a -> Map k a
`Map.union` Environment l
declEnv, $sel:currentModule:InhTC :: Ident
currentModule= Ident
m}
   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
-> Placed
     (Declaration
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Atts
     (Inherited (Auto TypeCheck))
     (Declaration
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Declaration
     l l (Semantics (Auto TypeCheck)) (Synthesized (Auto TypeCheck))
-> Declaration
     l l (Semantics (Auto TypeCheck)) (Inherited (Auto TypeCheck))
forall t (g :: (* -> *) -> (* -> *) -> *) (shallow :: * -> *)
       (sem :: * -> *).
(sem ~ Semantics t, Domain t ~ shallow, Revelation t shallow,
 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 Placed
  (Declaration
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
local Atts (Inherited (Auto TypeCheck)) (Declaration l l sem sem)
Atts
  (Inherited (Auto TypeCheck))
  (Declaration
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
inheritance Declaration l l sem (Synthesized (Auto TypeCheck))
Declaration
  l l (Semantics (Auto TypeCheck)) (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.Block l l Sem Sem) ~ SynTCMod 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 :: 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
_ ((Int, ParsedLexemes, Int)
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
_ ((Int, ParsedLexemes, Int)
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
_ ((Int, ParsedLexemes, Int)
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 (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
_ ((Int, ParsedLexemes, Int)
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
_ ((Int, ParsedLexemes, Int)
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 (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)))
-> 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.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.Block l l Sem Sem) ~ SynTCMod l,
          Atts (Synthesized (Auto TypeCheck)) (Abstract.ConstExpression l l Sem Sem) ~ SynTCExp l) =>
         SynthesizedField "pointerTargets" (Folded (Map AST.Ident AST.Ident)) (Auto TypeCheck)
                                           (AST.Declaration l l) Sem Placed where
   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)
synthesizedField Proxy "pointerTargets"
_ Auto TypeCheck
_ ((Int, ParsedLexemes, Int)
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 (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 :: 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
_ ((Int, ParsedLexemes, Int)
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 :: forall l.
Folded [Error l] -> Environment l -> Environment l -> SynTCHead l
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 (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\Synthesized
  (Auto TypeCheck)
  (FormalParameters
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
s-> SynTCSig l -> Folded [Error l]
forall l. SynTCSig l -> Folded [Error l]
errors (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)))
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized
  (Auto TypeCheck)
  (FormalParameters
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
s :: SynTCSig l)) 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 :: Environment l
outsideEnv= QualIdent l -> Type l -> Environment 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 -> Environment l) -> Type l -> Environment 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)))
-> 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 :: Environment l
insideEnv= (Synthesized
   (Auto TypeCheck)
   (FormalParameters
      l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
 -> Environment l)
-> Maybe
     (Synthesized
        (Auto TypeCheck)
        (FormalParameters
           l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
-> Environment l
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (SynTCSig l -> Environment l
forall l. SynTCSig l -> Environment l
signatureEnv (SynTCSig l -> Environment 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)))
-> Environment l
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
_ ((Int, ParsedLexemes, Int)
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)
      Atts (Inherited (Auto TypeCheck)) (ProcedureHeading l l sem sem)
inheritance (AST.TypeBoundHeading Bool
_var Ident
_name Ident
_type Bool
_indirect IdentDef l
_ Maybe (Synthesized (Auto TypeCheck) (FormalParameters l l sem sem))
sig) =
      SynTCHead :: forall l.
Folded [Error l] -> Environment l -> Environment l -> SynTCHead l
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 (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\Synthesized
  (Auto TypeCheck)
  (FormalParameters
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
s-> SynTCSig l -> Folded [Error l]
forall l. SynTCSig l -> Folded [Error l]
errors (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)))
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized
  (Auto TypeCheck)
  (FormalParameters
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
s :: SynTCSig l)) 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 :: Environment l
outsideEnv= case Ident -> Map Ident Ident -> Maybe Ident
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Ident
receiverType (InhTCDecl l -> Map Ident Ident
forall l. InhTCDecl l -> Map Ident Ident
pointerTargets (Atts (Inherited (Auto TypeCheck)) (ProcedureHeading l l sem sem)
InhTCDecl l
inheritance :: InhTCDecl l))
                            of Just Ident
targetName -> QualIdent l -> Type l -> Environment 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 -> Environment 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 :: Environment l
insideEnv= Environment l
receiverEnv Environment l -> Environment l -> Environment 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)))
 -> Environment l)
-> Maybe
     (Synthesized
        (Auto TypeCheck)
        (FormalParameters
           l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
-> Environment l
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (SynTCSig l -> Environment l
forall l. SynTCSig l -> Environment l
signatureEnv (SynTCSig l -> Environment 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)))
-> Environment l
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: Environment l
receiverEnv =
               (Type l -> Environment l) -> Maybe (Type l) -> Environment l
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (QualIdent l -> Type l -> Environment 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 -> Environment l)
-> (Type l -> Type l) -> Type l -> Environment l
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type l -> Type l
forall l. Type l -> Type l
ReceiverType)
                       (QualIdent l -> Environment 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) (Environment l -> Maybe (Type l))
-> Environment l -> Maybe (Type l)
forall a b. (a -> b) -> a -> b
$ InhTCDecl l -> Environment l
forall l. InhTCDecl l -> Environment l
env (Atts (Inherited (Auto TypeCheck)) (ProcedureHeading l l sem sem)
InhTCDecl l
inheritance :: InhTCDecl l))
            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)))
-> 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 -> Environment 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) (InhTCDecl l -> Environment l
forall l. InhTCDecl l -> Environment l
env (Atts (Inherited (Auto TypeCheck)) (ProcedureHeading l l sem sem)
InhTCDecl l
inheritance :: InhTCDecl l))
               of Maybe (Type l)
Nothing -> [Error l] -> Folded [Error l]
forall a. a -> Folded a
Folded [(InhTCDecl l -> Ident
forall l. InhTCDecl l -> Ident
currentModule (Atts (Inherited (Auto TypeCheck)) (ProcedureHeading l l sem sem)
InhTCDecl l
inheritance :: InhTCDecl l), (Int, ParsedLexemes, Int)
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 [(InhTCDecl l -> Ident
forall l. InhTCDecl l -> Ident
currentModule (Atts (Inherited (Auto TypeCheck)) (ProcedureHeading l l sem sem)
InhTCDecl l
inheritance :: InhTCDecl l), (Int, ParsedLexemes, Int)
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 :: 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
_ ((Int, ParsedLexemes, Int)
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 (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 (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> ZipList
     (Inherited
        (Auto TypeCheck)
        (Declaration
           l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inherited
   (Auto TypeCheck)
   (Declaration
      l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
 -> ZipList
      (Inherited
         (Auto TypeCheck)
         (Declaration
            l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))))
-> Inherited
     (Auto TypeCheck)
     (Declaration
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> ZipList
     (Inherited
        (Auto TypeCheck)
        (Declaration
           l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
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 :: forall l. Environment l -> Ident -> Map Ident Ident -> InhTCDecl l
InhTCDecl{$sel:env:InhTCDecl :: Environment l
env= Environment l
localEnv,
                                            $sel:currentModule:InhTCDecl :: Ident
currentModule= InhTC l -> Ident
forall l. InhTC l -> Ident
currentModule (Atts (Inherited (Auto TypeCheck)) (Block l l sem sem)
InhTC l
inheritance :: InhTC l),
                                            $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 (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Maybe
     (Inherited
        (Auto TypeCheck)
        (StatementSequence
           l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inherited
   (Auto TypeCheck)
   (StatementSequence
      l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
 -> Maybe
      (Inherited
         (Auto TypeCheck)
         (StatementSequence
            l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))))
-> Inherited
     (Auto TypeCheck)
     (StatementSequence
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Maybe
     (Inherited
        (Auto TypeCheck)
        (StatementSequence
           l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
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
localInherited)
      where localInherited :: InhTC l
localInherited = (Atts (Inherited (Auto TypeCheck)) (Block l l sem sem)
InhTC l
inheritance :: InhTC l){$sel:env:InhTC :: Environment l
env= Environment l
localEnv} -- (currentModule (inheritance :: InhTC l))
            localEnv :: Environment l
localEnv = 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 Environment l -> Environment l -> Environment l
forall a. Semigroup a => a -> a -> a
<> InhTC l -> Environment l
forall l. InhTC l -> Environment l
env (Atts (Inherited (Auto TypeCheck)) (Block l l sem sem)
InhTC l
inheritance :: InhTC l)
            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 (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\Synthesized
  (Auto TypeCheck)
  (Declaration
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
d-> SynTCMod l -> Folded (Map Ident Ident)
forall l. SynTCMod l -> Folded (Map Ident Ident)
pointerTargets (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)))
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized
  (Auto TypeCheck)
  (Declaration
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
d :: SynTCMod l)) 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 :: 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
_ ((Int, ParsedLexemes, Int)
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 :: 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 (Environment l) -> Environment 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 -> Environment l
forall l. SynTCMod l -> Environment l
moduleEnv (SynTCMod l -> Environment 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)))
-> Environment l
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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)))
 -> Environment l)
-> ZipList
     (Synthesized
        (Auto TypeCheck)
        (Declaration
           l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
-> ZipList (Environment 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 :: 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
_ ((Int, ParsedLexemes, Int)
pos, AST.FormalParameters ZipList
  (Sem
     (FPSection
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
sections Maybe (QualIdent l)
returnType) Atts (Inherited (Auto TypeCheck)) (FormalParameters l l sem sem)
inheritance (AST.FormalParameters ZipList (Synthesized (Auto TypeCheck) (FPSection l l sem sem))
sections' Maybe (QualIdent l)
_) =
      SynTCSig :: forall l. Folded [Error l] -> Environment l -> Type l -> SynTCSig 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 (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\Synthesized
  (Auto TypeCheck)
  (FPSection
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
s-> SynTCSec l -> Folded [Error l]
forall l. SynTCSec l -> Folded [Error l]
errors (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)))
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized
  (Auto TypeCheck)
  (FPSection
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
s :: SynTCSec l)) 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 (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 (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)))
-> 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 (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` InhTC l -> Map (QualIdent l) (Type l)
forall l. InhTC l -> Environment l
env (Atts (Inherited (Auto TypeCheck)) (FormalParameters l l sem sem)
InhTC l
inheritance :: InhTC l)),
               $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 (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)))
-> 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 (InhTC l -> Map (QualIdent l) (Type l)
forall l. InhTC l -> Environment l
env (Atts (Inherited (Auto TypeCheck)) (FormalParameters l l sem sem)
InhTC l
inheritance :: InhTC l)) = Folded [Error l]
forall a. Monoid a => a
mempty
               | Bool
otherwise = [Error l] -> Folded [Error l]
forall a. a -> Folded a
Folded [(InhTC l -> Ident
forall l. InhTC l -> Ident
currentModule (Atts (Inherited (Auto TypeCheck)) (FormalParameters l l sem sem)
InhTC l
inheritance :: InhTC l), (Int, ParsedLexemes, Int)
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 :: 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
_ ((Int, ParsedLexemes, Int)
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 :: forall l.
Folded [Error l] -> Environment l -> [(Bool, Type l)] -> SynTCSec l
SynTCSec{$sel:errors:SynTCSec :: Folded [Error l]
errors= SynTCType l -> Folded [Error l]
forall l. SynTCType l -> 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 :: SynTCType l),
               $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 (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 :: 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
_ ((Int, ParsedLexemes, Int)
pos, AST.TypeReference QualIdent l
q) Atts (Inherited (Auto TypeCheck)) (Type l l sem sem)
inheritance Type l l sem (Synthesized (Auto TypeCheck))
_ = 
      SynTCType :: forall l.
Folded [Error l]
-> Maybe Ident -> Type l -> Maybe Ident -> SynTCType l
SynTCType{$sel:errors:SynTCType :: Folded [Error l]
errors= if QualIdent l -> Map (QualIdent l) (Type l) -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member QualIdent l
q (InhTC l -> Map (QualIdent l) (Type l)
forall l. InhTC l -> Environment l
env (Atts (Inherited (Auto TypeCheck)) (Type l l sem sem)
InhTC l
inheritance :: InhTC l)) then Folded [Error l]
forall a. Monoid a => a
mempty
                        else [Error l] -> Folded [Error l]
forall a. a -> Folded a
Folded [(InhTC l -> Ident
forall l. InhTC l -> Ident
currentModule (Atts (Inherited (Auto TypeCheck)) (Type l l sem sem)
InhTC l
inheritance :: InhTC l), (Int, ParsedLexemes, Int)
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 -> Map (QualIdent l) (Type l) -> Maybe (Type l)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup QualIdent l
q (Map (QualIdent l) (Type l) -> Maybe (Type l))
-> Map (QualIdent l) (Type l) -> Maybe (Type l)
forall a b. (a -> b) -> a -> b
$ InhTC l -> Map (QualIdent l) (Type l)
forall l. InhTC l -> Environment l
env (Atts (Inherited (Auto TypeCheck)) (Type l l sem sem)
InhTC l
inheritance :: InhTC l))}
   synthesis Auto TypeCheck
_ ((Int, ParsedLexemes, Int)
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) Atts (Inherited (Auto TypeCheck)) (Type l l sem sem)
inheritance (AST.ArrayType ZipList
  (Synthesized (Auto TypeCheck) (ConstExpression l l sem sem))
dimensions Synthesized (Auto TypeCheck) (Type l l sem sem)
itemType) = 
      SynTCType :: forall l.
Folded [Error l]
-> Maybe Ident -> Type l -> Maybe Ident -> SynTCType l
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 (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\Synthesized
  (Auto TypeCheck)
  (ConstExpression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
d-> SynTCExp l -> Folded [Error l]
forall l. SynTCExp l -> Folded [Error l]
errors (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 (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
d :: SynTCExp l)) 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
<> SynTCType l -> Folded [Error l]
forall l. SynTCType l -> 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)))
itemType :: SynTCType l)
                        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 (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)))
-> 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)))
-> 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 [(InhTC l -> Ident
forall l. InhTC l -> Ident
currentModule (Atts (Inherited (Auto TypeCheck)) (Type l l sem sem)
InhTC l
inheritance :: InhTC l), (Int, ParsedLexemes, Int)
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
_ ((Int, ParsedLexemes, Int)
pos, AST.RecordType Maybe (QualIdent l)
base ZipList
  (Sem
     (FieldList
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
fields) Atts (Inherited (Auto TypeCheck)) (Type l l sem sem)
inheritance (AST.RecordType Maybe (QualIdent l)
_base ZipList (Synthesized (Auto TypeCheck) (FieldList l l sem sem))
fields') =
      SynTCType :: forall l.
Folded [Error l]
-> Maybe Ident -> Type l -> Maybe Ident -> SynTCType l
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 (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\Synthesized
  (Auto TypeCheck)
  (FieldList
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
f-> SynTCFields l -> Folded [Error l]
forall l. SynTCFields l -> Folded [Error l]
errors (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)))
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized
  (Auto TypeCheck)
  (FieldList
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
f :: SynTCFields l)) 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 (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)))
-> 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 -> Map (QualIdent l) (Type l) -> Maybe (Type l))
-> Map (QualIdent l) (Type l) -> QualIdent l -> Maybe (Type l)
forall a b c. (a -> b -> c) -> b -> a -> c
flip QualIdent l -> Map (QualIdent l) (Type l) -> Maybe (Type l)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (InhTC l -> Map (QualIdent l) (Type l)
forall l. InhTC l -> Environment l
env (Atts (Inherited (Auto TypeCheck)) (Type l l sem sem)
InhTC l
inheritance :: InhTC l)) (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 [(InhTC l -> Ident
forall l. InhTC l -> Ident
currentModule (Atts (Inherited (Auto TypeCheck)) (Type l l sem sem)
InhTC l
inheritance :: InhTC l), (Int, ParsedLexemes, Int)
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 (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
. (,,) (InhTC l -> Ident
forall l. InhTC l -> Ident
currentModule (Atts (Inherited (Auto TypeCheck)) (Type l l sem sem)
InhTC l
inheritance :: InhTC l)) (Int, ParsedLexemes, Int)
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 :: forall l.
Folded [Error l]
-> Maybe Ident -> Type l -> Maybe Ident -> SynTCType l
SynTCType{$sel:errors:SynTCType :: Folded [Error l]
errors= SynTCType l -> Folded [Error l]
forall l. SynTCType l -> 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' :: SynTCType l),
                $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
_ ((Int, ParsedLexemes, Int)
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 :: forall l.
Folded [Error l]
-> Maybe Ident -> Type l -> Maybe Ident -> SynTCType l
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 (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\Synthesized
  (Auto TypeCheck)
  (FormalParameters
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
s-> SynTCSig l -> Folded [Error l]
forall l. SynTCSig l -> Folded [Error l]
errors (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)))
forall t a. Synthesized t a -> Atts (Synthesized t) a
syn Synthesized
  (Auto TypeCheck)
  (FormalParameters
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
s :: SynTCSig l)) 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)))
-> 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 :: 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
_ ((Int, ParsedLexemes, Int)
_, 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 (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 :: 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
_ ((Int, ParsedLexemes, Int)
_pos, Statement
  l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))
AST.EmptyStatement) Atts (Inherited (Auto TypeCheck)) (Statement l l sem sem)
i Statement l l sem (Synthesized (Auto TypeCheck))
_   = Statement l l sem (Inherited (Auto TypeCheck))
forall λ l (f' :: * -> *) (f :: * -> *). Statement λ l f' f
AST.EmptyStatement
   bequest Auto TypeCheck
_ ((Int, ParsedLexemes, Int)
_pos, AST.Assignment{}) Atts (Inherited (Auto TypeCheck)) (Statement l l sem sem)
i Statement l l sem (Synthesized (Auto TypeCheck))
_     = Inherited (Auto TypeCheck) (Designator l l sem sem)
-> Inherited (Auto TypeCheck) (Expression l l sem sem)
-> Statement l l sem (Inherited (Auto TypeCheck))
forall λ l (f' :: * -> *) (f :: * -> *).
f (Designator l l f' f')
-> f (Expression l l f' f') -> Statement λ l f' f
AST.Assignment (Atts
  (Inherited (Auto TypeCheck))
  (Designator
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Inherited
     (Auto TypeCheck)
     (Designator
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
forall t a. Atts (Inherited t) a -> Inherited t a
AG.Inherited Atts
  (Inherited (Auto TypeCheck))
  (Designator
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
Atts (Inherited (Auto TypeCheck)) (Statement l l sem sem)
i) (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
AG.Inherited Atts
  (Inherited (Auto TypeCheck))
  (Expression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
Atts (Inherited (Auto TypeCheck)) (Statement l l sem sem)
i)
   bequest Auto TypeCheck
_ ((Int, ParsedLexemes, Int)
_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)))))
args) Atts (Inherited (Auto TypeCheck)) (Statement l l sem sem)
i Statement l l sem (Synthesized (Auto TypeCheck))
_  =
      Inherited (Auto TypeCheck) (Designator l l sem sem)
-> Maybe
     (ZipList (Inherited (Auto TypeCheck) (Expression l l sem sem)))
-> Statement l l sem (Inherited (Auto TypeCheck))
forall λ l (f' :: * -> *) (f :: * -> *).
f (Designator l l f' f')
-> Maybe (ZipList (f (Expression l l f' f'))) -> Statement λ l f' f
AST.ProcedureCall (Atts
  (Inherited (Auto TypeCheck))
  (Designator
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Inherited
     (Auto TypeCheck)
     (Designator
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
forall t a. Atts (Inherited t) a -> Inherited t a
AG.Inherited Atts
  (Inherited (Auto TypeCheck))
  (Designator
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
Atts (Inherited (Auto TypeCheck)) (Statement l l sem sem)
i) ((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
AG.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)
  (Expression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> ZipList
     (Sem
        (Expression
           l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
-> ZipList
     (Inherited
        (Auto TypeCheck)
        (Expression
           l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$) (ZipList
   (Sem
      (Expression
         l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
 -> ZipList
      (Inherited
         (Auto TypeCheck)
         (Expression
            l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))))
-> Maybe
     (ZipList
        (Sem
           (Expression
              l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))))
-> Maybe
     (ZipList
        (Inherited
           (Auto TypeCheck)
           (Expression
              l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe
  (ZipList
     (Sem
        (Expression
           l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))))
args)
   bequest Auto TypeCheck
_ ((Int, ParsedLexemes, Int)
_pos, AST.If Sem
  (ConditionalBranch
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
_branch ZipList
  (Sem
     (ConditionalBranch
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
branches Maybe
  (Sem
     (StatementSequence
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
_fallback) Atts (Inherited (Auto TypeCheck)) (Statement l l sem sem)
i Statement l l sem (Synthesized (Auto TypeCheck))
_ =
      Inherited (Auto TypeCheck) (ConditionalBranch l l sem sem)
-> ZipList
     (Inherited (Auto TypeCheck) (ConditionalBranch 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 (ConditionalBranch l l f' f')
-> ZipList (f (ConditionalBranch l l f' f'))
-> Maybe (f (StatementSequence l l f' f'))
-> Statement λ l f' f
AST.If (Atts
  (Inherited (Auto TypeCheck))
  (ConditionalBranch
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Inherited
     (Auto TypeCheck)
     (ConditionalBranch
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
forall t a. Atts (Inherited t) a -> Inherited t a
AG.Inherited Atts
  (Inherited (Auto TypeCheck))
  (ConditionalBranch
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
Atts (Inherited (Auto TypeCheck)) (Statement l l sem sem)
i) (Atts
  (Inherited (Auto TypeCheck))
  (ConditionalBranch
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Inherited
     (Auto TypeCheck)
     (ConditionalBranch
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
forall t a. Atts (Inherited t) a -> Inherited t a
AG.Inherited Atts
  (Inherited (Auto TypeCheck))
  (ConditionalBranch
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
Atts (Inherited (Auto TypeCheck)) (Statement l l sem sem)
i Inherited
  (Auto TypeCheck)
  (ConditionalBranch
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> ZipList
     (Sem
        (ConditionalBranch
           l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
-> ZipList
     (Inherited
        (Auto TypeCheck)
        (ConditionalBranch
           l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ZipList
  (Sem
     (ConditionalBranch
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
branches) (Inherited
  (Auto TypeCheck)
  (StatementSequence
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Maybe
     (Inherited
        (Auto TypeCheck)
        (StatementSequence
           l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
forall a. a -> Maybe a
Just (Inherited
   (Auto TypeCheck)
   (StatementSequence
      l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
 -> Maybe
      (Inherited
         (Auto TypeCheck)
         (StatementSequence
            l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))))
-> Inherited
     (Auto TypeCheck)
     (StatementSequence
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Maybe
     (Inherited
        (Auto TypeCheck)
        (StatementSequence
           l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
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
AG.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
_ ((Int, ParsedLexemes, Int)
_pos, AST.CaseStatement{}) Atts (Inherited (Auto TypeCheck)) (Statement l l sem sem)
i (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 (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> ZipList
     (Inherited
        (Auto TypeCheck)
        (Case
           l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inherited
   (Auto TypeCheck)
   (Case
      l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
 -> ZipList
      (Inherited
         (Auto TypeCheck)
         (Case
            l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))))
-> Inherited
     (Auto TypeCheck)
     (Case
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> ZipList
     (Inherited
        (Auto TypeCheck)
        (Case
           l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
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 :: forall l. Environment l -> Ident -> Type l -> InhTCExp l
InhTCExp{$sel:currentModule:InhTCExp :: Ident
currentModule= InhTC l -> Ident
forall l. InhTC l -> Ident
currentModule (Atts (Inherited (Auto TypeCheck)) (Statement l l sem sem)
InhTC l
i :: InhTC l),
                                                                 $sel:env:InhTCExp :: Environment l
env= InhTC l -> Environment l
forall l. InhTC l -> Environment l
env (Atts (Inherited (Auto TypeCheck)) (Statement l l sem sem)
InhTC l
i :: InhTC l),
                                                                 $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 (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Maybe
     (Inherited
        (Auto TypeCheck)
        (StatementSequence
           l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
forall a. a -> Maybe a
Just (Inherited
   (Auto TypeCheck)
   (StatementSequence
      l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
 -> Maybe
      (Inherited
         (Auto TypeCheck)
         (StatementSequence
            l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))))
-> Inherited
     (Auto TypeCheck)
     (StatementSequence
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Maybe
     (Inherited
        (Auto TypeCheck)
        (StatementSequence
           l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
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
_ ((Int, ParsedLexemes, Int)
_pos, AST.While{}) Atts (Inherited (Auto TypeCheck)) (Statement l l sem sem)
i Statement l l sem (Synthesized (Auto TypeCheck))
_          = Inherited (Auto TypeCheck) (Expression l l sem sem)
-> 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')
-> f (StatementSequence l l f' f') -> Statement λ l f' f
AST.While (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
AG.Inherited Atts
  (Inherited (Auto TypeCheck))
  (Expression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
Atts (Inherited (Auto TypeCheck)) (Statement l l sem sem)
i) (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
AG.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
_ ((Int, ParsedLexemes, Int)
_pos, AST.Repeat{}) Atts (Inherited (Auto TypeCheck)) (Statement l l sem sem)
i Statement l l sem (Synthesized (Auto TypeCheck))
_         = Inherited (Auto TypeCheck) (StatementSequence l l sem sem)
-> Inherited (Auto TypeCheck) (Expression l l sem sem)
-> Statement l l sem (Inherited (Auto TypeCheck))
forall λ l (f' :: * -> *) (f :: * -> *).
f (StatementSequence l l f' f')
-> f (Expression l l f' f') -> Statement λ l f' f
AST.Repeat (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
AG.Inherited Atts
  (Inherited (Auto TypeCheck))
  (StatementSequence
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
Atts (Inherited (Auto TypeCheck)) (Statement l l sem sem)
i) (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
AG.Inherited Atts
  (Inherited (Auto TypeCheck))
  (Expression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
Atts (Inherited (Auto TypeCheck)) (Statement l l sem sem)
i)
   bequest Auto TypeCheck
_ ((Int, ParsedLexemes, Int)
_pos, AST.For Ident
name Sem
  (Expression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
_ Sem
  (Expression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
_ Maybe
  (Sem
     (Expression
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
_ Sem
  (StatementSequence
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
_) Atts (Inherited (Auto TypeCheck)) (Statement l l sem sem)
i Statement l l sem (Synthesized (Auto TypeCheck))
_ =
      Ident
-> Inherited (Auto TypeCheck) (Expression l l sem sem)
-> Inherited (Auto TypeCheck) (Expression l l sem sem)
-> Maybe (Inherited (Auto TypeCheck) (Expression l l sem sem))
-> Inherited (Auto TypeCheck) (StatementSequence l l sem sem)
-> Statement l l sem (Inherited (Auto TypeCheck))
forall λ l (f' :: * -> *) (f :: * -> *).
Ident
-> f (Expression l l f' f')
-> f (Expression l l f' f')
-> Maybe (f (Expression l l f' f'))
-> f (StatementSequence l l f' f')
-> Statement λ l f' f
AST.For Ident
name (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
AG.Inherited Atts
  (Inherited (Auto TypeCheck))
  (Expression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
Atts (Inherited (Auto TypeCheck)) (Statement l l sem sem)
i) (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
AG.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)
  (Expression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Maybe
     (Inherited
        (Auto TypeCheck)
        (Expression
           l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inherited
   (Auto TypeCheck)
   (Expression
      l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
 -> Maybe
      (Inherited
         (Auto TypeCheck)
         (Expression
            l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))))
-> Inherited
     (Auto TypeCheck)
     (Expression
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Maybe
     (Inherited
        (Auto TypeCheck)
        (Expression
           l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
forall a b. (a -> b) -> a -> b
$ 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
AG.Inherited Atts
  (Inherited (Auto TypeCheck))
  (Expression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
Atts (Inherited (Auto TypeCheck)) (Statement l l sem sem)
i) (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
AG.Inherited Atts
  (Inherited (Auto TypeCheck))
  (StatementSequence
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
Atts (Inherited (Auto TypeCheck)) (Statement l l sem sem)
i)  -- Oberon2
   bequest Auto TypeCheck
_ ((Int, ParsedLexemes, Int)
_pos, AST.Loop{}) Atts (Inherited (Auto TypeCheck)) (Statement l l sem sem)
i Statement l l sem (Synthesized (Auto TypeCheck))
_           = Inherited (Auto TypeCheck) (StatementSequence l l sem sem)
-> Statement l l sem (Inherited (Auto TypeCheck))
forall λ l (f' :: * -> *) (f :: * -> *).
f (StatementSequence l l f' f') -> Statement λ l f' f
AST.Loop (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
AG.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
_ ((Int, ParsedLexemes, Int)
_pos, AST.With{}) Atts (Inherited (Auto TypeCheck)) (Statement l l sem sem)
i Statement l l sem (Synthesized (Auto TypeCheck))
_           =
      Inherited (Auto TypeCheck) (WithAlternative l l sem sem)
-> ZipList
     (Inherited (Auto TypeCheck) (WithAlternative 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 (WithAlternative l l f' f')
-> ZipList (f (WithAlternative l l f' f'))
-> Maybe (f (StatementSequence l l f' f'))
-> Statement λ l f' f
AST.With (Atts
  (Inherited (Auto TypeCheck))
  (WithAlternative
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Inherited
     (Auto TypeCheck)
     (WithAlternative
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
forall t a. Atts (Inherited t) a -> Inherited t a
AG.Inherited Atts
  (Inherited (Auto TypeCheck))
  (WithAlternative
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
Atts (Inherited (Auto TypeCheck)) (Statement l l sem sem)
i) (Inherited
  (Auto TypeCheck)
  (WithAlternative
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> ZipList
     (Inherited
        (Auto TypeCheck)
        (WithAlternative
           l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Inherited
   (Auto TypeCheck)
   (WithAlternative
      l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
 -> ZipList
      (Inherited
         (Auto TypeCheck)
         (WithAlternative
            l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))))
-> Inherited
     (Auto TypeCheck)
     (WithAlternative
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> ZipList
     (Inherited
        (Auto TypeCheck)
        (WithAlternative
           l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
forall a b. (a -> b) -> a -> b
$ Atts
  (Inherited (Auto TypeCheck))
  (WithAlternative
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Inherited
     (Auto TypeCheck)
     (WithAlternative
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
forall t a. Atts (Inherited t) a -> Inherited t a
AG.Inherited Atts
  (Inherited (Auto TypeCheck))
  (WithAlternative
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
Atts (Inherited (Auto TypeCheck)) (Statement l l sem sem)
i) (Inherited
  (Auto TypeCheck)
  (StatementSequence
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Maybe
     (Inherited
        (Auto TypeCheck)
        (StatementSequence
           l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
forall a. a -> Maybe a
Just (Inherited
   (Auto TypeCheck)
   (StatementSequence
      l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
 -> Maybe
      (Inherited
         (Auto TypeCheck)
         (StatementSequence
            l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))))
-> Inherited
     (Auto TypeCheck)
     (StatementSequence
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Maybe
     (Inherited
        (Auto TypeCheck)
        (StatementSequence
           l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
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
AG.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
_ ((Int, ParsedLexemes, Int)
_pos, AST.Exit{}) Atts (Inherited (Auto TypeCheck)) (Statement l l sem sem)
i Statement l l sem (Synthesized (Auto TypeCheck))
_           = Statement l l sem (Inherited (Auto TypeCheck))
forall λ l (f' :: * -> *) (f :: * -> *). Statement λ l f' f
AST.Exit
   bequest Auto TypeCheck
_ ((Int, ParsedLexemes, Int)
_pos, AST.Return{}) Atts (Inherited (Auto TypeCheck)) (Statement l l sem sem)
i Statement l l sem (Synthesized (Auto TypeCheck))
_         = Maybe (Inherited (Auto TypeCheck) (Expression l l sem sem))
-> Statement l l sem (Inherited (Auto TypeCheck))
forall λ l (f' :: * -> *) (f :: * -> *).
Maybe (f (Expression l l f' f')) -> Statement λ l f' f
AST.Return (Inherited
  (Auto TypeCheck)
  (Expression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Maybe
     (Inherited
        (Auto TypeCheck)
        (Expression
           l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
forall a. a -> Maybe a
Just (Inherited
   (Auto TypeCheck)
   (Expression
      l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
 -> Maybe
      (Inherited
         (Auto TypeCheck)
         (Expression
            l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))))
-> Inherited
     (Auto TypeCheck)
     (Expression
        l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
-> Maybe
     (Inherited
        (Auto TypeCheck)
        (Expression
           l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
forall a b. (a -> b) -> a -> b
$ 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
AG.Inherited Atts
  (Inherited (Auto TypeCheck))
  (Expression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
Atts (Inherited (Auto TypeCheck)) (Statement l l sem sem)
i)

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 :: 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 ((Int, ParsedLexemes, Int)
pos, Statement
  l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))
_) Atts (Inherited (Auto TypeCheck)) (Statement l l sem sem)
inheritance 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 :: forall l. Folded [Error l] -> SynTC l
SynTC{$sel:errors:SynTC :: Folded [Error l]
errors= Ident
-> (Int, ParsedLexemes, Int)
-> Type l
-> Type l
-> Folded [Error l]
forall l.
(Nameable l, Eq (QualIdent l)) =>
Ident
-> (Int, ParsedLexemes, Int)
-> Type l
-> Type l
-> Folded [Error l]
assignmentCompatible (InhTC l -> Ident
forall l. InhTC l -> Ident
currentModule (Atts (Inherited (Auto TypeCheck)) (Statement l l sem sem)
InhTC l
inheritance :: InhTC l)) (Int, ParsedLexemes, Int)
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
_ ((Int, ParsedLexemes, Int)
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 :: forall l. Folded [Error l] -> SynTC l
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{errors= Folded [],
                                 designatorType= t} -> Type l -> Folded [Error l]
procedureErrors Type l
t
                        SynTCDes{errors= 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 (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 (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)))
p-> SynTCExp l -> Folded [Error l]
forall l. SynTCExp l -> Folded [Error l]
errors (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 (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
p :: SynTCExp l))) 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 (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 (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 (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 (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 (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 (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)))
-> 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. [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 [(InhTC l -> Ident
forall l. InhTC l -> Ident
currentModule (Atts (Inherited (Auto TypeCheck)) (Statement l l sem sem)
InhTC l
inheritance :: InhTC l), (Int, ParsedLexemes, Int)
pos,
                          Int -> Int -> ErrorType l
forall l. Int -> Int -> ErrorType l
ArgumentCountMismatch ([(Bool, Type l)] -> 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 (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 (InhTC l
-> (Int, ParsedLexemes, Int)
-> (Bool, Type l)
-> Type l
-> Folded [Error l]
forall l.
(Nameable l, Eq (QualIdent l)) =>
InhTC l
-> (Int, ParsedLexemes, Int)
-> (Bool, Type l)
-> Type l
-> Folded [Error l]
parameterCompatible Atts (Inherited (Auto TypeCheck)) (Statement l l sem sem)
InhTC l
inheritance (Int, ParsedLexemes, Int)
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)))
-> 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 [(InhTC l -> Ident
forall l. InhTC l -> Ident
currentModule (Atts (Inherited (Auto TypeCheck)) (Statement l l sem sem)
InhTC l
inheritance :: InhTC l), (Int, ParsedLexemes, Int)
pos, Type l -> ErrorType l
forall l. Type l -> ErrorType l
NonProcedureType Type l
t)]
   synthesis Auto TypeCheck
_ ((Int, ParsedLexemes, Int)
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 :: forall l. Folded [Error l] -> SynTC l
SynTC{$sel:errors:SynTC :: Folded [Error l]
errors= InhTC l
-> (Int, ParsedLexemes, Int) -> SynTCExp l -> Folded [Error l]
forall l.
InhTC l
-> (Int, ParsedLexemes, Int) -> SynTCExp l -> Folded [Error l]
booleanExpressionErrors Atts (Inherited (Auto TypeCheck)) (Statement l l sem sem)
InhTC l
inheritance (Int, ParsedLexemes, Int)
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
<> SynTC l -> Folded [Error l]
forall l. SynTC l -> Folded [Error l]
errors (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 :: SynTC l)}
   synthesis Auto TypeCheck
_ ((Int, ParsedLexemes, Int)
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 :: forall l. Folded [Error l] -> SynTC l
SynTC{$sel:errors:SynTC :: Folded [Error l]
errors= InhTC l
-> (Int, ParsedLexemes, Int) -> SynTCExp l -> Folded [Error l]
forall l.
InhTC l
-> (Int, ParsedLexemes, Int) -> SynTCExp l -> Folded [Error l]
booleanExpressionErrors Atts (Inherited (Auto TypeCheck)) (Statement l l sem sem)
InhTC l
inheritance (Int, ParsedLexemes, Int)
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
<> SynTC l -> Folded [Error l]
forall l. SynTC l -> Folded [Error l]
errors (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 :: SynTC l)}
   synthesis Auto TypeCheck
_ ((Int, ParsedLexemes, Int)
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 :: forall l. Folded [Error l] -> SynTC l
SynTC{$sel:errors:SynTC :: Folded [Error l]
errors= InhTC l
-> (Int, ParsedLexemes, Int) -> SynTCExp l -> Folded [Error l]
forall l.
InhTC l
-> (Int, ParsedLexemes, Int) -> SynTCExp l -> Folded [Error l]
integerExpressionErrors Atts (Inherited (Auto TypeCheck)) (Statement l l sem sem)
InhTC l
inheritance (Int, ParsedLexemes, Int)
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
<> InhTC l
-> (Int, ParsedLexemes, Int) -> SynTCExp l -> Folded [Error l]
forall l.
InhTC l
-> (Int, ParsedLexemes, Int) -> SynTCExp l -> Folded [Error l]
integerExpressionErrors Atts (Inherited (Auto TypeCheck)) (Statement l l sem sem)
InhTC l
inheritance (Int, ParsedLexemes, Int)
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 (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (InhTC l
-> (Int, ParsedLexemes, Int) -> SynTCExp l -> Folded [Error l]
forall l.
InhTC l
-> (Int, ParsedLexemes, Int) -> SynTCExp l -> Folded [Error l]
integerExpressionErrors Atts (Inherited (Auto TypeCheck)) (Statement l l sem sem)
InhTC l
inheritance (Int, ParsedLexemes, Int)
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)))
-> 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
<> SynTC l -> Folded [Error l]
forall l. SynTC l -> Folded [Error l]
errors (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 :: SynTC l)}
   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 :: forall l. Folded [Error l] -> SynTC l
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
_ ((Int, ParsedLexemes, Int)
pos, AST.WithAlternative QualIdent l
var QualIdent l
subtype Sem
  (StatementSequence
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
_body)
                         (Inherited Atts (Inherited (Auto TypeCheck)) (WithAlternative l l sem sem)
inheritance, 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 sem)
-> Synthesized (Auto TypeCheck) (WithAlternative l l sem sem)
forall t a. Atts (Synthesized t) a -> Synthesized t a
Synthesized SynTC :: forall l. Folded [Error l] -> SynTC l
SynTC{$sel:errors:SynTC :: Folded [Error l]
errors= case (QualIdent l -> Map (QualIdent l) (Type l) -> Maybe (Type l)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup QualIdent l
var (Map (QualIdent l) (Type l) -> Maybe (Type l))
-> Map (QualIdent l) (Type l) -> Maybe (Type l)
forall a b. (a -> b) -> a -> b
$ InhTC l -> Map (QualIdent l) (Type l)
forall l. InhTC l -> Environment l
env (Atts (Inherited (Auto TypeCheck)) (WithAlternative l l sem sem)
InhTC l
inheritance :: InhTC l),
                                       QualIdent l -> Map (QualIdent l) (Type l) -> Maybe (Type l)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup QualIdent l
subtype (Map (QualIdent l) (Type l) -> Maybe (Type l))
-> Map (QualIdent l) (Type l) -> Maybe (Type l)
forall a b. (a -> b) -> a -> b
$ InhTC l -> Map (QualIdent l) (Type l)
forall l. InhTC l -> Environment l
env (Atts (Inherited (Auto TypeCheck)) (WithAlternative l l sem sem)
InhTC l
inheritance :: InhTC l))
                                 of (Just Type l
supertype, Just Type l
subtypeDef) ->
                                      Ident
-> (Int, ParsedLexemes, Int)
-> Type l
-> Type l
-> Folded [Error l]
forall l.
(Nameable l, Eq (QualIdent l)) =>
Ident
-> (Int, ParsedLexemes, Int)
-> Type l
-> Type l
-> Folded [Error l]
assignmentCompatible (InhTC l -> Ident
forall l. InhTC l -> Ident
currentModule (Atts (Inherited (Auto TypeCheck)) (WithAlternative l l sem sem)
InhTC l
inheritance :: InhTC l)) (Int, ParsedLexemes, Int)
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 [(InhTC l -> Ident
forall l. InhTC l -> Ident
currentModule (Atts (Inherited (Auto TypeCheck)) (WithAlternative l l sem sem)
InhTC l
inheritance :: InhTC l), (Int, ParsedLexemes, Int)
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 [(InhTC l -> Ident
forall l. InhTC l -> Ident
currentModule (Atts (Inherited (Auto TypeCheck)) (WithAlternative l l sem sem)
InhTC l
inheritance :: InhTC l), (Int, ParsedLexemes, Int)
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
<> SynTC l -> Folded [Error l]
forall l. SynTC l -> Folded [Error l]
errors (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 :: SynTC l)},
       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 (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)))
 -> Inherited
      (Auto TypeCheck)
      (StatementSequence
         l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
-> 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 a b. (a -> b) -> a -> b
$ 
                                        Map (QualIdent l) (Type l) -> Ident -> InhTC l
forall l. Environment l -> Ident -> InhTC l
InhTC ((Map (QualIdent l) (Type l) -> Map (QualIdent l) (Type l))
-> (Type l
    -> Map (QualIdent l) (Type l) -> Map (QualIdent l) (Type l))
-> Maybe (Type l)
-> Map (QualIdent l) (Type l)
-> Map (QualIdent l) (Type l)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Map (QualIdent l) (Type l) -> Map (QualIdent l) (Type l)
forall a. a -> a
id (QualIdent l
-> Type l
-> Map (QualIdent l) (Type l)
-> Map (QualIdent l) (Type l)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert QualIdent l
var) (QualIdent l -> Map (QualIdent l) (Type l) -> Maybe (Type l)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup QualIdent l
subtype
                                                                          (Map (QualIdent l) (Type l) -> Maybe (Type l))
-> Map (QualIdent l) (Type l) -> Maybe (Type l)
forall a b. (a -> b) -> a -> b
$ InhTC l -> Map (QualIdent l) (Type l)
forall l. InhTC l -> Environment l
env (Atts (Inherited (Auto TypeCheck)) (WithAlternative l l sem sem)
InhTC l
inheritance :: InhTC l)) 
                                               (Map (QualIdent l) (Type l) -> Map (QualIdent l) (Type l))
-> Map (QualIdent l) (Type l) -> Map (QualIdent l) (Type l)
forall a b. (a -> b) -> a -> b
$ InhTC l -> Map (QualIdent l) (Type l)
forall l. InhTC l -> Environment l
env (Atts (Inherited (Auto TypeCheck)) (WithAlternative l l sem sem)
InhTC l
inheritance :: InhTC l))
                                              (InhTC l -> Ident
forall l. InhTC l -> Ident
currentModule (Atts (Inherited (Auto TypeCheck)) (WithAlternative l l sem sem)
InhTC l
inheritance :: InhTC l))))

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 :: 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
_ ((Int, ParsedLexemes, Int)
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 :: forall l. Folded [Error l] -> SynTC l
SynTC{$sel:errors:SynTC :: Folded [Error l]
errors= InhTC l
-> (Int, ParsedLexemes, Int) -> SynTCExp l -> Folded [Error l]
forall l.
InhTC l
-> (Int, ParsedLexemes, Int) -> SynTCExp l -> Folded [Error l]
booleanExpressionErrors Atts (Inherited (Auto TypeCheck)) (ConditionalBranch l l sem sem)
InhTC l
inheritance (Int, ParsedLexemes, Int)
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
<> SynTC l -> Folded [Error l]
forall l. SynTC l -> Folded [Error l]
errors (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 :: SynTC l)}

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 :: 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
_ ((Int, ParsedLexemes, Int)
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 :: forall l. Folded [Error l] -> SynTC l
SynTC{$sel:errors:SynTC :: Folded [Error l]
errors= InhTCExp l
-> (Int, ParsedLexemes, Int) -> Type l -> Folded [Error l]
forall l.
(Nameable l, Eq (QualIdent l)) =>
InhTCExp l
-> (Int, ParsedLexemes, Int) -> Type l -> Folded [Error l]
assignmentCompatibleIn Atts (Inherited (Auto TypeCheck)) (CaseLabels l l sem sem)
InhTCExp l
inheritance (Int, ParsedLexemes, Int)
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
_ ((Int, ParsedLexemes, Int)
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 :: forall l. Folded [Error l] -> SynTC l
SynTC{$sel:errors:SynTC :: Folded [Error l]
errors= InhTCExp l
-> (Int, ParsedLexemes, Int) -> Type l -> Folded [Error l]
forall l.
(Nameable l, Eq (QualIdent l)) =>
InhTCExp l
-> (Int, ParsedLexemes, Int) -> Type l -> Folded [Error l]
assignmentCompatibleIn Atts (Inherited (Auto TypeCheck)) (CaseLabels l l sem sem)
InhTCExp l
inheritance (Int, ParsedLexemes, Int)
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
-> (Int, ParsedLexemes, Int) -> Type l -> Folded [Error l]
forall l.
(Nameable l, Eq (QualIdent l)) =>
InhTCExp l
-> (Int, ParsedLexemes, Int) -> Type l -> Folded [Error l]
assignmentCompatibleIn Atts (Inherited (Auto TypeCheck)) (CaseLabels l l sem sem)
InhTCExp l
inheritance (Int, ParsedLexemes, Int)
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 :: 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
_ ((Int, ParsedLexemes, Int)
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)))
_) Atts (Inherited (Auto TypeCheck)) (Expression l l sem sem)
inheritance (AST.Relation RelOp
_op Synthesized (Auto TypeCheck) (Expression l l sem sem)
left Synthesized (Auto TypeCheck) (Expression l l sem sem)
right) =
      SynTCExp :: forall l. Folded [Error l] -> Type l -> SynTCExp l
SynTCExp{$sel:errors:SynTCExp :: Folded [Error l]
errors= case SynTCExp l -> Folded [Error l]
forall l. SynTCExp l -> Folded [Error l]
errors (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 :: SynTCExp l) Folded [Error l] -> Folded [Error l] -> Folded [Error l]
forall a. Semigroup a => a -> a -> a
<> SynTCExp l -> Folded [Error l]
forall l. SynTCExp l -> Folded [Error l]
errors (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 :: SynTCExp l)
                       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 [] <- Ident
-> (Int, ParsedLexemes, Int)
-> Type l
-> Type l
-> Folded [Error l]
forall l.
(Nameable l, Eq (QualIdent l)) =>
Ident
-> (Int, ParsedLexemes, Int)
-> Type l
-> Type l
-> Folded [Error l]
assignmentCompatible (InhTC l -> Ident
forall l. InhTC l -> Ident
currentModule (Atts (Inherited (Auto TypeCheck)) (Expression l l sem sem)
InhTC l
inheritance :: InhTC l)) (Int, ParsedLexemes, Int)
pos Type l
t1 Type l
t2
                              -> Folded [Error l]
forall a. Monoid a => a
mempty
                            | RelOp -> Bool
equality RelOp
op,
                              Folded [] <- Ident
-> (Int, ParsedLexemes, Int)
-> Type l
-> Type l
-> Folded [Error l]
forall l.
(Nameable l, Eq (QualIdent l)) =>
Ident
-> (Int, ParsedLexemes, Int)
-> Type l
-> Type l
-> Folded [Error l]
assignmentCompatible (InhTC l -> Ident
forall l. InhTC l -> Ident
currentModule (Atts (Inherited (Auto TypeCheck)) (Expression l l sem sem)
InhTC l
inheritance :: InhTC l)) (Int, ParsedLexemes, Int)
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 [(InhTC l -> Ident
forall l. InhTC l -> Ident
currentModule (Atts (Inherited (Auto TypeCheck)) (Expression l l sem sem)
InhTC l
inheritance :: InhTC l), (Int, ParsedLexemes, Int)
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
_ ((Int, ParsedLexemes, Int)
pos, AST.IsA Sem
  (Expression
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
_ QualIdent l
q) Atts (Inherited (Auto TypeCheck)) (Expression l l sem sem)
inheritance (AST.IsA Synthesized (Auto TypeCheck) (Expression l l sem sem)
left QualIdent l
_) =
      SynTCExp :: forall l. Folded [Error l] -> Type l -> SynTCExp l
SynTCExp{$sel:errors:SynTCExp :: Folded [Error l]
errors= case QualIdent l -> Map (QualIdent l) (Type l) -> Maybe (Type l)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup QualIdent l
q (InhTC l -> Map (QualIdent l) (Type l)
forall l. InhTC l -> Environment l
env (Atts (Inherited (Auto TypeCheck)) (Expression l l sem sem)
InhTC l
inheritance :: InhTC l))
                       of Maybe (Type l)
Nothing -> [Error l] -> Folded [Error l]
forall a. a -> Folded a
Folded [(InhTC l -> Ident
forall l. InhTC l -> Ident
currentModule (Atts (Inherited (Auto TypeCheck)) (Expression l l sem sem)
InhTC l
inheritance :: InhTC l), (Int, ParsedLexemes, Int)
pos, QualIdent l -> ErrorType l
forall l. QualIdent l -> ErrorType l
UnknownName QualIdent l
q)]
                          Just Type l
t -> Ident
-> (Int, ParsedLexemes, Int)
-> Type l
-> Type l
-> Folded [Error l]
forall l.
(Nameable l, Eq (QualIdent l)) =>
Ident
-> (Int, ParsedLexemes, Int)
-> Type l
-> Type l
-> Folded [Error l]
assignmentCompatible (InhTC l -> Ident
forall l. InhTC l -> Ident
currentModule (Atts (Inherited (Auto TypeCheck)) (Expression l l sem sem)
InhTC l
inheritance :: InhTC l)) (Int, ParsedLexemes, Int)
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
_ ((Int, ParsedLexemes, Int)
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 :: forall l. Folded [Error l] -> Type l -> SynTCExp l
SynTCExp{$sel:errors:SynTCExp :: Folded [Error l]
errors= InhTC l
-> (Int, ParsedLexemes, Int) -> SynTCExp l -> Folded [Error l]
forall l.
Nameable l =>
InhTC l
-> (Int, ParsedLexemes, Int) -> SynTCExp l -> Folded [Error l]
unaryNumericOrSetOperatorErrors Atts (Inherited (Auto TypeCheck)) (Expression l l sem sem)
InhTC l
inheritance (Int, ParsedLexemes, Int)
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
_ ((Int, ParsedLexemes, Int)
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 :: forall l. Folded [Error l] -> Type l -> SynTCExp l
SynTCExp{$sel:errors:SynTCExp :: Folded [Error l]
errors= InhTC l
-> (Int, ParsedLexemes, Int) -> SynTCExp l -> Folded [Error l]
forall l.
Nameable l =>
InhTC l
-> (Int, ParsedLexemes, Int) -> SynTCExp l -> Folded [Error l]
unaryNumericOrSetOperatorErrors Atts (Inherited (Auto TypeCheck)) (Expression l l sem sem)
InhTC l
inheritance (Int, ParsedLexemes, Int)
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
_ ((Int, ParsedLexemes, Int)
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) =
      InhTC l
-> (Int, ParsedLexemes, Int)
-> 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 l t a t a.
(Nameable l, Eq (QualIdent l), Atts (Synthesized t) a ~ SynTCExp l,
 Atts (Synthesized t) a ~ SynTCExp l) =>
InhTC l
-> (Int, ParsedLexemes, Int)
-> Synthesized t a
-> Synthesized t a
-> SynTCExp l
binaryNumericOrSetSynthesis Atts (Inherited (Auto TypeCheck)) (Expression l l sem sem)
InhTC l
inheritance (Int, ParsedLexemes, Int)
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
_ ((Int, ParsedLexemes, Int)
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) =
      InhTC l
-> (Int, ParsedLexemes, Int)
-> 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 l t a t a.
(Nameable l, Eq (QualIdent l), Atts (Synthesized t) a ~ SynTCExp l,
 Atts (Synthesized t) a ~ SynTCExp l) =>
InhTC l
-> (Int, ParsedLexemes, Int)
-> Synthesized t a
-> Synthesized t a
-> SynTCExp l
binaryNumericOrSetSynthesis Atts (Inherited (Auto TypeCheck)) (Expression l l sem sem)
InhTC l
inheritance (Int, ParsedLexemes, Int)
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
_ ((Int, ParsedLexemes, Int)
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) = InhTC l
-> (Int, ParsedLexemes, Int)
-> 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 l t a t a.
(Nameable l, Eq (QualIdent l), Atts (Synthesized t) a ~ SynTCExp l,
 Atts (Synthesized t) a ~ SynTCExp l) =>
InhTC l
-> (Int, ParsedLexemes, Int)
-> Synthesized t a
-> Synthesized t a
-> SynTCExp l
binaryBooleanSynthesis Atts (Inherited (Auto TypeCheck)) (Expression l l sem sem)
InhTC l
inheritance (Int, ParsedLexemes, Int)
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
_ ((Int, ParsedLexemes, Int)
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) =
      InhTC l
-> (Int, ParsedLexemes, Int)
-> 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 l t a t a.
(Nameable l, Eq (QualIdent l), Atts (Synthesized t) a ~ SynTCExp l,
 Atts (Synthesized t) a ~ SynTCExp l) =>
InhTC l
-> (Int, ParsedLexemes, Int)
-> Synthesized t a
-> Synthesized t a
-> SynTCExp l
binaryNumericOrSetSynthesis Atts (Inherited (Auto TypeCheck)) (Expression l l sem sem)
InhTC l
inheritance (Int, ParsedLexemes, Int)
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
_ ((Int, ParsedLexemes, Int)
pos, Expression
  l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))
_) Atts (Inherited (Auto TypeCheck)) (Expression l l sem sem)
inheritance (AST.Divide Synthesized (Auto TypeCheck) (Expression l l sem sem)
left Synthesized (Auto TypeCheck) (Expression l l sem sem)
right) =
      SynTCExp :: forall l. Folded [Error l] -> Type l -> SynTCExp l
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 [(InhTC l -> Ident
forall l. InhTC l -> Ident
currentModule (Atts (Inherited (Auto TypeCheck)) (Expression l l sem sem)
InhTC l
inheritance :: InhTC l), (Int, ParsedLexemes, Int)
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 [(InhTC l -> Ident
forall l. InhTC l -> Ident
currentModule (Atts (Inherited (Auto TypeCheck)) (Expression l l sem sem)
InhTC l
inheritance :: InhTC l), (Int, ParsedLexemes, Int)
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
_ ((Int, ParsedLexemes, Int)
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) =
      InhTC l
-> (Int, ParsedLexemes, Int)
-> 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 l t a t a.
(Nameable l, Eq (QualIdent l), Atts (Synthesized t) a ~ SynTCExp l,
 Atts (Synthesized t) a ~ SynTCExp l) =>
InhTC l
-> (Int, ParsedLexemes, Int)
-> Synthesized t a
-> Synthesized t a
-> SynTCExp l
binaryIntegerSynthesis Atts (Inherited (Auto TypeCheck)) (Expression l l sem sem)
InhTC l
inheritance (Int, ParsedLexemes, Int)
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
_ ((Int, ParsedLexemes, Int)
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) = InhTC l
-> (Int, ParsedLexemes, Int)
-> 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 l t a t a.
(Nameable l, Eq (QualIdent l), Atts (Synthesized t) a ~ SynTCExp l,
 Atts (Synthesized t) a ~ SynTCExp l) =>
InhTC l
-> (Int, ParsedLexemes, Int)
-> Synthesized t a
-> Synthesized t a
-> SynTCExp l
binaryIntegerSynthesis Atts (Inherited (Auto TypeCheck)) (Expression l l sem sem)
InhTC l
inheritance (Int, ParsedLexemes, Int)
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
_ ((Int, ParsedLexemes, Int)
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) = InhTC l
-> (Int, ParsedLexemes, Int)
-> 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 l t a t a.
(Nameable l, Eq (QualIdent l), Atts (Synthesized t) a ~ SynTCExp l,
 Atts (Synthesized t) a ~ SynTCExp l) =>
InhTC l
-> (Int, ParsedLexemes, Int)
-> Synthesized t a
-> Synthesized t a
-> SynTCExp l
binaryBooleanSynthesis Atts (Inherited (Auto TypeCheck)) (Expression l l sem sem)
InhTC l
inheritance (Int, ParsedLexemes, Int)
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 :: forall l. Folded [Error l] -> Type l -> SynTCExp l
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 :: forall l. Folded [Error l] -> Type l -> SynTCExp l
SynTCExp{$sel:errors:SynTCExp :: Folded [Error l]
errors= SynTCDes l -> Folded [Error l]
forall l. SynTCDes l -> 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 :: SynTCDes l),
               $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 :: forall l. Folded [Error l] -> Type l -> SynTCExp l
SynTCExp{$sel:errors:SynTCExp :: Folded [Error l]
errors= SynTCExp l -> Folded [Error l]
forall l. SynTCExp l -> 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 :: SynTCExp l),
               $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
_ ((Int, ParsedLexemes, Int)
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 :: forall l. Folded [Error l] -> Type l -> SynTCExp l
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{errors= Folded [],
                               designatorName= name,
                               designatorType= ultimate -> ProcedureType _ formalTypes Just{}}
                        | [(Bool, Type l)] -> 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 (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 [(InhTC l -> Ident
forall l. InhTC l -> Ident
currentModule (Atts (Inherited (Auto TypeCheck)) (Expression l l sem sem)
InhTC l
inheritance :: InhTC l), (Int, ParsedLexemes, Int)
pos,
                                     Int -> Int -> ErrorType l
forall l. Int -> Int -> ErrorType l
ArgumentCountMismatch ([(Bool, Type l)] -> 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 (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 (InhTC l
-> (Int, ParsedLexemes, Int)
-> (Bool, Type l)
-> Type l
-> Folded [Error l]
forall l.
(Nameable l, Eq (QualIdent l)) =>
InhTC l
-> (Int, ParsedLexemes, Int)
-> (Bool, Type l)
-> Type l
-> Folded [Error l]
parameterCompatible Atts (Inherited (Auto TypeCheck)) (Expression l l sem sem)
InhTC l
inheritance (Int, ParsedLexemes, Int)
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)))
-> 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{errors= Folded [],
                               designatorType= t} -> [Error l] -> Folded [Error l]
forall a. a -> Folded a
Folded [(InhTC l -> Ident
forall l. InhTC l -> Ident
currentModule (Atts (Inherited (Auto TypeCheck)) (Expression l l sem sem)
InhTC l
inheritance :: InhTC l),
                                                              (Int, ParsedLexemes, Int)
pos, Type l -> ErrorType l
forall l. Type l -> ErrorType l
NonFunctionType Type l
t)]
                      SynTCDes{errors= 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 (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)))
p-> SynTCExp l -> Folded [Error l]
forall l. SynTCExp l -> Folded [Error l]
errors (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 (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
p :: SynTCExp l)) [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{designatorName= Just (Just "SYSTEM", 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)))
-> 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{designatorName= d, designatorType= 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
_ ((Int, ParsedLexemes, Int)
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 :: forall l. Folded [Error l] -> Type l -> SynTCExp l
SynTCExp{$sel:errors:SynTCExp :: Folded [Error l]
errors= InhTC l
-> (Int, ParsedLexemes, Int) -> SynTCExp l -> Folded [Error l]
forall l.
InhTC l
-> (Int, ParsedLexemes, Int) -> SynTCExp l -> Folded [Error l]
booleanExpressionErrors Atts (Inherited (Auto TypeCheck)) (Expression l l sem sem)
InhTC l
inheritance (Int, ParsedLexemes, Int)
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 SynthesizedField "errors" (Folded [Error l]) (Auto TypeCheck) (AST.Value l l) Sem Placed where
   synthesizedField :: Proxy "errors"
-> 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))
-> Folded [Error l]
synthesizedField = Proxy "errors"
-> 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))
-> Folded [Error l]
forall a. Monoid a => a
mempty
  
instance Abstract.Wirthy l => SynthesizedField "inferredType" (Type l) (Auto TypeCheck) (AST.Value l l) Sem Placed where
   synthesizedField :: 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
_ ((Int, ParsedLexemes, Int)
_, 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
_ ((Int, ParsedLexemes, Int)
_, 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
_ ((Int, ParsedLexemes, Int)
_, 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
_ ((Int, ParsedLexemes, Int)
_, 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
_ ((Int, ParsedLexemes, Int)
_, 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
_ ((Int, ParsedLexemes, Int)
_, 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
_ ((Int, ParsedLexemes, Int)
_, 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 :: 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
_ ((Int, ParsedLexemes, Int)
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) = InhTC l
-> (Int, ParsedLexemes, Int) -> SynTCExp l -> Folded [Error l]
forall l.
InhTC l
-> (Int, ParsedLexemes, Int) -> SynTCExp l -> Folded [Error l]
integerExpressionErrors Atts (Inherited (Auto TypeCheck)) (Element l l sem sem)
InhTC l
inheritance (Int, ParsedLexemes, Int)
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
_ ((Int, ParsedLexemes, Int)
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) = InhTC l
-> (Int, ParsedLexemes, Int) -> SynTCExp l -> Folded [Error l]
forall l.
InhTC l
-> (Int, ParsedLexemes, Int) -> SynTCExp l -> Folded [Error l]
integerExpressionErrors Atts (Inherited (Auto TypeCheck)) (Element l l sem sem)
InhTC l
inheritance (Int, ParsedLexemes, Int)
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
<> InhTC l
-> (Int, ParsedLexemes, Int) -> SynTCExp l -> Folded [Error l]
forall l.
InhTC l
-> (Int, ParsedLexemes, Int) -> SynTCExp l -> Folded [Error l]
integerExpressionErrors Atts (Inherited (Auto TypeCheck)) (Element l l sem sem)
InhTC l
inheritance (Int, ParsedLexemes, Int)
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 :: 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 :: 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
_ ((Int, ParsedLexemes, Int)
pos, AST.Variable QualIdent l
q) Atts (Inherited (Auto TypeCheck)) (Designator l l sem sem)
inheritance Designator l l sem (Synthesized (Auto TypeCheck))
_ =
      SynTCDes :: forall l.
Folded [Error l]
-> Maybe (Maybe Ident, Ident) -> Type l -> SynTCDes l
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 [(InhTC l -> Ident
forall l. InhTC l -> Ident
currentModule (Atts (Inherited (Auto TypeCheck)) (Designator l l sem sem)
InhTC l
inheritance :: InhTC l), (Int, ParsedLexemes, Int)
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 (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Ident -> Maybe Ident) -> (Ident, Ident) -> (Maybe Ident, Ident)
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 -> Map (QualIdent l) (Type l) -> Maybe (Type l)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup QualIdent l
q (InhTC l -> Map (QualIdent l) (Type l)
forall l. InhTC l -> Environment l
env (Atts (Inherited (Auto TypeCheck)) (Designator l l sem sem)
InhTC l
inheritance :: InhTC l))
   synthesis Auto TypeCheck
_ ((Int, ParsedLexemes, Int)
pos, AST.Field Sem
  (Designator
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
_record Ident
fieldName) Atts (Inherited (Auto TypeCheck)) (Designator l l sem sem)
inheritance (AST.Field Synthesized (Auto TypeCheck) (Designator l l sem sem)
record Ident
_fieldName) =
      SynTCDes :: forall l.
Folded [Error l]
-> Maybe (Maybe Ident, Ident) -> Type l -> SynTCDes l
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{errors= Folded [],
                                   designatorType= 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 [(InhTC l -> Ident
forall l. InhTC l -> Ident
currentModule (Atts (Inherited (Auto TypeCheck)) (Designator l l sem sem)
InhTC l
inheritance :: InhTC l), (Int, ParsedLexemes, Int)
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 [(InhTC l -> Ident
forall l. InhTC l -> Ident
currentModule (Atts (Inherited (Auto TypeCheck)) (Designator l l sem sem)
InhTC l
inheritance :: InhTC l), (Int, ParsedLexemes, Int)
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{errors= 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
_ ((Int, ParsedLexemes, Int)
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) Atts (Inherited (Auto TypeCheck)) (Designator l l sem sem)
inheritance (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 :: forall l.
Folded [Error l]
-> Maybe (Maybe Ident, Ident) -> Type l -> SynTCDes l
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{errors= Folded [],
                                   designatorType= 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{errors= errors} -> Folded [Error l]
errors,
               $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 (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 (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 (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 (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 [(InhTC l -> Ident
forall l. InhTC l -> Ident
currentModule (Atts (Inherited (Auto TypeCheck)) (Designator l l sem sem)
InhTC l
inheritance :: InhTC l), (Int, ParsedLexemes, Int)
pos,
                                           Int -> Int -> ErrorType l
forall l. Int -> Int -> ErrorType l
ExtraDimensionalIndex ([Int] -> 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 (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 [(InhTC l -> Ident
forall l. InhTC l -> Ident
currentModule (Atts (Inherited (Auto TypeCheck)) (Designator l l sem sem)
InhTC l
inheritance :: InhTC l), (Int, ParsedLexemes, Int)
pos, Type l -> ErrorType l
forall l. Type l -> ErrorType l
NonArrayType Type l
t)])
   synthesis Auto TypeCheck
_ ((Int, ParsedLexemes, Int)
pos, AST.TypeGuard Sem
  (Designator
     l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
_designator QualIdent l
q) Atts (Inherited (Auto TypeCheck)) (Designator l l sem sem)
inheritance (AST.TypeGuard Synthesized (Auto TypeCheck) (Designator l l sem sem)
designator QualIdent l
_q) =
      SynTCDes :: forall l.
Folded [Error l]
-> Maybe (Maybe Ident, Ident) -> Type l -> SynTCDes l
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') -> Ident
-> (Int, ParsedLexemes, Int)
-> Type l
-> Type l
-> Folded [Error l]
forall l.
(Nameable l, Eq (QualIdent l)) =>
Ident
-> (Int, ParsedLexemes, Int)
-> Type l
-> Type l
-> Folded [Error l]
assignmentCompatible (InhTC l -> Ident
forall l. InhTC l -> Ident
currentModule (Atts (Inherited (Auto TypeCheck)) (Designator l l sem sem)
InhTC l
inheritance :: InhTC l)) (Int, ParsedLexemes, Int)
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 ((InhTC l -> Ident
forall l. InhTC l -> Ident
currentModule (Atts (Inherited (Auto TypeCheck)) (Designator l l sem sem)
InhTC l
inheritance :: InhTC l),
                                                          (Int, ParsedLexemes, Int)
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: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 -> Map (QualIdent l) (Type l) -> Maybe (Type l)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup QualIdent l
q (InhTC l -> Map (QualIdent l) (Type l)
forall l. InhTC l -> Environment l
env (Atts (Inherited (Auto TypeCheck)) (Designator l l sem sem)
InhTC l
inheritance :: InhTC l))
   synthesis Auto TypeCheck
_ ((Int, ParsedLexemes, Int)
pos, Designator
  l l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))
_) Atts (Inherited (Auto TypeCheck)) (Designator l l sem sem)
inheritance (AST.Dereference Synthesized (Auto TypeCheck) (Designator l l sem sem)
pointer) =
      SynTCDes :: forall l.
Folded [Error l]
-> Maybe (Maybe Ident, Ident) -> Type l -> SynTCDes l
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{errors= Folded [],
                                   designatorType= PointerType{}} -> Folded [Error l]
forall a. Monoid a => a
mempty
                          SynTCDes{errors= Folded [],
                                   designatorType= NominalType _ (Just PointerType{})} -> Folded [Error l]
forall a. Monoid a => a
mempty
                          SynTCDes{errors= Folded [],
                                   designatorType= ProcedureType True _ _} -> Folded [Error l]
forall a. Monoid a => a
mempty
                          SynTCDes{errors= Folded [],
                                   designatorType= t} -> [Error l] -> Folded [Error l]
forall a. a -> Folded a
Folded [(InhTC l -> Ident
forall l. InhTC l -> Ident
currentModule (Atts (Inherited (Auto TypeCheck)) (Designator l l sem sem)
InhTC l
inheritance :: InhTC l),
                                                                  (Int, ParsedLexemes, Int)
pos, Type l -> ErrorType l
forall l. Type l -> ErrorType l
NonPointerType Type l
t)]
                          SynTCDes{errors= es} -> Folded [Error l]
es,
               $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 :: InhTC l
-> (Int, ParsedLexemes, Int)
-> Synthesized t a
-> Synthesized t a
-> SynTCExp l
binaryNumericOrSetSynthesis InhTC l
inheritance (Int, ParsedLexemes, Int)
pos Synthesized t a
left Synthesized t a
right =
   SynTCExp :: forall l. Folded [Error l] -> Type l -> SynTCExp l
SynTCExp{$sel:errors:SynTCExp :: Folded [Error l]
errors= InhTC l
-> (Int, ParsedLexemes, Int)
-> SynTCExp l
-> SynTCExp l
-> Folded [Error l]
forall l.
(Nameable l, Eq (QualIdent l)) =>
InhTC l
-> (Int, ParsedLexemes, Int)
-> SynTCExp l
-> SynTCExp l
-> Folded [Error l]
binarySetOrNumericOperatorErrors InhTC l
inheritance (Int, ParsedLexemes, Int)
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 :: InhTC l
-> (Int, ParsedLexemes, Int)
-> Synthesized t a
-> Synthesized t a
-> SynTCExp l
binaryIntegerSynthesis InhTC l
inheritance (Int, ParsedLexemes, Int)
pos Synthesized t a
left Synthesized t a
right =
   SynTCExp :: forall l. Folded [Error l] -> Type l -> SynTCExp l
SynTCExp{$sel:errors:SynTCExp :: Folded [Error l]
errors= InhTC l
-> (Int, ParsedLexemes, Int)
-> SynTCExp l
-> SynTCExp l
-> Folded [Error l]
forall l.
Nameable l =>
InhTC l
-> (Int, ParsedLexemes, Int)
-> SynTCExp l
-> SynTCExp l
-> Folded [Error l]
binaryIntegerOperatorErrors InhTC l
inheritance (Int, ParsedLexemes, Int)
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 :: InhTC l
-> (Int, ParsedLexemes, Int)
-> Synthesized t a
-> Synthesized t a
-> SynTCExp l
binaryBooleanSynthesis InhTC l
inheritance (Int, ParsedLexemes, Int)
pos Synthesized t a
left Synthesized t a
right =
   SynTCExp :: forall l. Folded [Error l] -> Type l -> SynTCExp l
SynTCExp{$sel:errors:SynTCExp :: Folded [Error l]
errors= InhTC l
-> (Int, ParsedLexemes, Int)
-> SynTCExp l
-> SynTCExp l
-> Folded [Error l]
forall l.
(Nameable l, Eq (QualIdent l)) =>
InhTC l
-> (Int, ParsedLexemes, Int)
-> SynTCExp l
-> SynTCExp l
-> Folded [Error l]
binaryBooleanOperatorErrors InhTC l
inheritance (Int, ParsedLexemes, Int)
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 =>
                                   InhTC l -> (Int, ParsedLexemes, Int) -> SynTCExp l -> Folded [Error l]
unaryNumericOrSetOperatorErrors :: InhTC l
-> (Int, ParsedLexemes, Int) -> SynTCExp l -> Folded [Error l]
unaryNumericOrSetOperatorErrors InhTC l
_ (Int, ParsedLexemes, Int)
_ 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
unaryNumericOrSetOperatorErrors InhTC l
_ (Int, ParsedLexemes, Int)
_ 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
  | Ident
name Ident -> Ident -> Bool
forall a. Eq a => a -> a -> Bool
== Ident
"SET" = Folded [Error l]
forall a. Monoid a => a
mempty
unaryNumericOrSetOperatorErrors InhTC l
inheritance (Int, ParsedLexemes, Int)
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 [(InhTC l -> Ident
forall l. InhTC l -> Ident
currentModule (InhTC l
inheritance :: InhTC l), (Int, ParsedLexemes, Int)
pos, Type l -> ErrorType l
forall l. Type l -> ErrorType l
NonNumericType Type l
t)]
unaryNumericOrSetOperatorErrors InhTC l
_ (Int, ParsedLexemes, Int)
_ 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 :: (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))
                                 => InhTC l -> (Int, ParsedLexemes, Int) -> SynTCExp l -> SynTCExp l -> Folded [Error l]
binarySetOrNumericOperatorErrors :: InhTC l
-> (Int, ParsedLexemes, Int)
-> SynTCExp l
-> SynTCExp l
-> Folded [Error l]
binarySetOrNumericOperatorErrors InhTC l
_ (Int, ParsedLexemes, Int)
_
  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 InhTC l
_ (Int, ParsedLexemes, Int)
_
  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 InhTC l
_ (Int, ParsedLexemes, Int)
_
  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 InhTC l
_ (Int, ParsedLexemes, Int)
_
  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 InhTC l
inheritance (Int, ParsedLexemes, Int)
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 [(InhTC l -> Ident
forall l. InhTC l -> Ident
currentModule (InhTC l
inheritance :: InhTC l), (Int, ParsedLexemes, Int)
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 [(InhTC l -> Ident
forall l. InhTC l -> Ident
currentModule (InhTC l
inheritance :: InhTC l), (Int, ParsedLexemes, Int)
pos, Type l -> Type l -> ErrorType l
forall l. Type l -> Type l -> ErrorType l
TypeMismatch Type l
t1 Type l
t2)]
binarySetOrNumericOperatorErrors InhTC l
_ (Int, ParsedLexemes, Int)
_ 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 :: 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. [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 =>
                               InhTC l -> (Int, ParsedLexemes, Int) ->  SynTCExp l -> SynTCExp l -> Folded [Error l]
binaryIntegerOperatorErrors :: InhTC l
-> (Int, ParsedLexemes, Int)
-> SynTCExp l
-> SynTCExp l
-> Folded [Error l]
binaryIntegerOperatorErrors InhTC l
inheritance (Int, ParsedLexemes, Int)
pos SynTCExp l
syn1 SynTCExp l
syn2 = InhTC l
-> (Int, ParsedLexemes, Int) -> SynTCExp l -> Folded [Error l]
forall l.
InhTC l
-> (Int, ParsedLexemes, Int) -> SynTCExp l -> Folded [Error l]
integerExpressionErrors InhTC l
inheritance (Int, ParsedLexemes, Int)
pos SynTCExp l
syn1 
                                                      Folded [Error l] -> Folded [Error l] -> Folded [Error l]
forall a. Semigroup a => a -> a -> a
<> InhTC l
-> (Int, ParsedLexemes, Int) -> SynTCExp l -> Folded [Error l]
forall l.
InhTC l
-> (Int, ParsedLexemes, Int) -> SynTCExp l -> Folded [Error l]
integerExpressionErrors InhTC l
inheritance (Int, ParsedLexemes, Int)
pos SynTCExp l
syn2

integerExpressionErrors :: forall l. InhTC l -> (Int, ParsedLexemes, Int) -> SynTCExp l -> Folded [Error l]
integerExpressionErrors :: InhTC l
-> (Int, ParsedLexemes, Int) -> SynTCExp l -> Folded [Error l]
integerExpressionErrors InhTC l
inheritance (Int, ParsedLexemes, Int)
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 [(InhTC l -> Ident
forall l. InhTC l -> Ident
currentModule (InhTC l
inheritance :: InhTC l), (Int, ParsedLexemes, Int)
pos, Type l -> ErrorType l
forall l. Type l -> ErrorType l
NonIntegerType Type l
t)]
integerExpressionErrors InhTC l
_ (Int, ParsedLexemes, Int)
_ 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. InhTC l -> (Int, ParsedLexemes, Int) -> SynTCExp l -> Folded [Error l]
booleanExpressionErrors :: InhTC l
-> (Int, ParsedLexemes, Int) -> SynTCExp l -> Folded [Error l]
booleanExpressionErrors InhTC l
_ (Int, ParsedLexemes, Int)
_ 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 InhTC l
inheritance (Int, ParsedLexemes, Int)
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 [(InhTC l -> Ident
forall l. InhTC l -> Ident
currentModule (InhTC l
inheritance :: InhTC l), (Int, ParsedLexemes, Int)
pos, Type l -> ErrorType l
forall l. Type l -> ErrorType l
NonBooleanType Type l
t)]
booleanExpressionErrors InhTC l
_ (Int, ParsedLexemes, Int)
_ 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))
                            => InhTC l -> (Int, ParsedLexemes, Int) -> SynTCExp l -> SynTCExp l -> Folded [Error l]
binaryBooleanOperatorErrors :: InhTC l
-> (Int, ParsedLexemes, Int)
-> SynTCExp l
-> SynTCExp l
-> Folded [Error l]
binaryBooleanOperatorErrors InhTC l
_inh (Int, ParsedLexemes, Int)
_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 InhTC l
inheritance (Int, ParsedLexemes, Int)
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 [(InhTC l -> Ident
forall l. InhTC l -> Ident
currentModule (InhTC l
inheritance :: InhTC l), (Int, ParsedLexemes, Int)
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 [(InhTC l -> Ident
forall l. InhTC l -> Ident
currentModule (InhTC l
inheritance :: InhTC l), (Int, ParsedLexemes, Int)
pos, Type l -> Type l -> ErrorType l
forall l. Type l -> Type l -> ErrorType l
TypeMismatch Type l
t1 Type l
t2)]
binaryBooleanOperatorErrors InhTC l
_ (Int, ParsedLexemes, Int)
_ 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))
                    => InhTC l -> (Int, ParsedLexemes, Int) -> (Bool, Type l) -> Type l -> Folded [Error l]
parameterCompatible :: InhTC l
-> (Int, ParsedLexemes, Int)
-> (Bool, Type l)
-> Type l
-> Folded [Error l]
parameterCompatible InhTC l
_ (Int, ParsedLexemes, Int)
_ (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 InhTC l
inheritance (Int, ParsedLexemes, Int)
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 [(InhTC l -> Ident
forall l. InhTC l -> Ident
currentModule (InhTC l
inheritance :: InhTC l), (Int, ParsedLexemes, Int)
pos, Type l -> Type l -> ErrorType l
forall l. Type l -> Type l -> ErrorType l
UnequalTypes Type l
expected Type l
actual)]
parameterCompatible InhTC l
inheritance (Int, ParsedLexemes, Int)
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 = Ident
-> (Int, ParsedLexemes, Int)
-> Type l
-> Type l
-> Folded [Error l]
forall l.
(Nameable l, Eq (QualIdent l)) =>
Ident
-> (Int, ParsedLexemes, Int)
-> Type l
-> Type l
-> Folded [Error l]
assignmentCompatible (InhTC l -> Ident
forall l. InhTC l -> Ident
currentModule (InhTC l
inheritance :: InhTC l)) (Int, ParsedLexemes, Int)
pos Type l
expected Type l
actual

assignmentCompatibleIn :: forall l. (Abstract.Nameable l, Eq (Abstract.QualIdent l))
                       => InhTCExp l -> (Int, ParsedLexemes, Int) -> Type l -> Folded [Error l]
assignmentCompatibleIn :: InhTCExp l
-> (Int, ParsedLexemes, Int) -> Type l -> Folded [Error l]
assignmentCompatibleIn InhTCExp l
inheritance (Int, ParsedLexemes, Int)
pos =
  Ident
-> (Int, ParsedLexemes, Int)
-> Type l
-> Type l
-> Folded [Error l]
forall l.
(Nameable l, Eq (QualIdent l)) =>
Ident
-> (Int, ParsedLexemes, Int)
-> Type l
-> Type l
-> Folded [Error l]
assignmentCompatible (InhTCExp l -> Ident
forall l. InhTCExp l -> Ident
currentModule (InhTCExp l
inheritance :: InhTCExp l)) (Int, ParsedLexemes, Int)
pos (InhTCExp l -> Type l
forall l. InhTCExp l -> Type l
expectedType (InhTCExp l
inheritance :: InhTCExp l))

assignmentCompatible :: forall l. (Abstract.Nameable l, Eq (Abstract.QualIdent l))
                     => AST.Ident -> (Int, ParsedLexemes, Int) -> Type l -> Type l -> Folded [Error l]
assignmentCompatible :: Ident
-> (Int, ParsedLexemes, Int)
-> Type l
-> Type l
-> Folded [Error l]
assignmentCompatible Ident
currModule (Int, ParsedLexemes, Int)
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 (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 =
       Ident
-> (Int, ParsedLexemes, Int)
-> Type l
-> Type l
-> Folded [Error l]
forall l.
(Nameable l, Eq (QualIdent l)) =>
Ident
-> (Int, ParsedLexemes, Int)
-> Type l
-> Type l
-> Folded [Error l]
assignmentCompatible Ident
currModule (Int, ParsedLexemes, Int)
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 = Ident
-> (Int, ParsedLexemes, Int)
-> Type l
-> Type l
-> Folded [Error l]
forall l.
(Nameable l, Eq (QualIdent l)) =>
Ident
-> (Int, ParsedLexemes, Int)
-> Type l
-> Type l
-> Folded [Error l]
assignmentCompatible Ident
currModule (Int, ParsedLexemes, Int)
pos Type l
expected Type l
t
   | ReceiverType Type l
t <- Type l
expected = Ident
-> (Int, ParsedLexemes, Int)
-> Type l
-> Type l
-> Folded [Error l]
forall l.
(Nameable l, Eq (QualIdent l)) =>
Ident
-> (Int, ParsedLexemes, Int)
-> Type l
-> Type l
-> Folded [Error l]
assignmentCompatible Ident
currModule (Int, ParsedLexemes, Int)
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 = Ident
-> (Int, ParsedLexemes, Int)
-> Type l
-> Type l
-> Folded [Error l]
forall l.
(Nameable l, Eq (QualIdent l)) =>
Ident
-> (Int, ParsedLexemes, Int)
-> Type l
-> Type l
-> Folded [Error l]
assignmentCompatible Ident
currModule (Int, ParsedLexemes, Int)
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 [(Ident
currModule, (Int, ParsedLexemes, Int)
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 = Ident
-> (Int, ParsedLexemes, Int)
-> Type l
-> Type l
-> Folded [Error l]
forall l.
(Nameable l, Eq (QualIdent l)) =>
Ident
-> (Int, ParsedLexemes, Int)
-> Type l
-> Type l
-> Folded [Error l]
assignmentCompatible Ident
currModule (Int, ParsedLexemes, Int)
pos Type l
t Type l
actual
   | Bool
otherwise = [Error l] -> Folded [Error l]
forall a. a -> Folded a
Folded [(Ident
currModule, (Int, ParsedLexemes, Int)
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 :: 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 (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 :: 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 (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 :: 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 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. ((Int, ParsedLexemes, Int), a) -> a)
-> Auto TypeCheck
-> ((Int, ParsedLexemes, Int),
    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 forall a. ((Int, ParsedLexemes, Int), 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 <*> :: 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 l]
checkModules :: Environment l
-> Map Ident (Placed (Module l l Placed Placed)) -> [Error l]
checkModules Environment l
predef Map Ident (Placed (Module l l Placed Placed))
modules =
   Folded [Error l] -> [Error l]
forall a. Folded a -> a
getFolded (SynTC l -> Folded [Error l]
forall l. SynTC l -> Folded [Error l]
errors (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))
-> ((Int, ParsedLexemes, Int),
    Modules
      l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck)))
forall b. b -> ((Int, ParsedLexemes, Int), b)
wrap (Modules
   l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))
 -> ((Int, ParsedLexemes, Int),
     Modules
       l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))))
-> Modules
     l (Semantics (Auto TypeCheck)) (Semantics (Auto TypeCheck))
-> ((Int, ParsedLexemes, Int),
    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 (Environment l -> InhTCRoot l
forall l. Environment l -> InhTCRoot l
InhTCRoot Environment l
predef)) :: SynTC l))
   where wrap :: b -> ((Int, ParsedLexemes, Int), 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 :: Environment l
predefined = [(QualIdent l, Type l)] -> Environment l
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(QualIdent l, Type l)] -> Environment l)
-> [(QualIdent l, Type l)] -> Environment 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 (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 :: Environment l
predefined2 = Environment l
forall l. (Wirthy l, Ord (QualIdent l)) => Environment l
predefined Environment l -> Environment l -> Environment l
forall a. Semigroup a => a -> a -> a
<>
   [(QualIdent l, Type l)] -> Environment l
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ((Ident -> QualIdent l) -> (Ident, Type l) -> (QualIdent l, Type l)
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)])

$(do l <- varT <$> newName "l"
     mconcat <$> mapM (\t-> Transformation.Full.TH.deriveUpFunctor (conT ''Auto `appT` conT ''TypeCheck)
                            $ conT t `appT` l `appT` l)
        [''AST.Declaration, ''AST.Type, ''AST.FieldList,
         ''AST.ProcedureHeading, ''AST.FormalParameters, ''AST.FPSection,
         ''AST.Expression, ''AST.Element, ''AST.Designator,
         ''AST.Block, ''AST.StatementSequence, ''AST.Statement,
         ''AST.Case, ''AST.CaseLabels, ''AST.ConditionalBranch, ''AST.Value, ''AST.WithAlternative])

$(do let sem = [t|Semantics (Auto TypeCheck)|]
     let inst g = [d| instance Attribution (Auto TypeCheck) ($g l l) Sem Placed =>
                               Transformation.At (Auto TypeCheck) ($g l l $sem $sem)
                         where ($) = AG.applyDefault snd |]
     mconcat <$> mapM (inst . conT)
        [''AST.Module, ''AST.Declaration, ''AST.Type, ''AST.FieldList,
         ''AST.ProcedureHeading, ''AST.FormalParameters, ''AST.FPSection,
         ''AST.Block, ''AST.StatementSequence, ''AST.Statement,
         ''AST.Case, ''AST.CaseLabels, ''AST.ConditionalBranch, ''AST.WithAlternative,
         ''AST.Expression, ''AST.Element, ''AST.Designator, ''AST.Value])