Safe Haskell | Safe-Inferred |
---|---|
Language | Haskell2010 |
Synopsis
- analyseTypes :: Data a => ProgramFile (Analysis a) -> (ProgramFile (Analysis a), TypeEnv)
- analyseTypesWithEnv :: Data a => TypeEnv -> ProgramFile (Analysis a) -> (ProgramFile (Analysis a), TypeEnv)
- analyseAndCheckTypesWithEnv :: Data a => TypeEnv -> ProgramFile (Analysis a) -> (ProgramFile (Analysis a), TypeEnv, [TypeError])
- extractTypeEnv :: forall a. Data a => ProgramFile (Analysis a) -> TypeEnv
- type TypeEnv = Map Name IDType
- type TypeError = (String, SrcSpan)
- deriveSemTypeFromDeclaration :: (MonadState InferState m, MonadReader InferConfig m) => SrcSpan -> SrcSpan -> TypeSpec a -> Maybe (Expression a) -> m SemType
- deriveSemTypeFromTypeSpec :: MonadState InferState m => TypeSpec a -> m SemType
- deriveSemTypeFromBaseType :: BaseType -> SemType
- runInfer :: FortranVersion -> TypeEnv -> Infer a -> (a, InferState)
- inferState0 :: FortranVersion -> InferState
Documentation
analyseTypes :: Data a => ProgramFile (Analysis a) -> (ProgramFile (Analysis a), TypeEnv) Source #
Annotate AST nodes with type information and also return a type environment mapping names to type information.
analyseTypesWithEnv :: Data a => TypeEnv -> ProgramFile (Analysis a) -> (ProgramFile (Analysis a), TypeEnv) Source #
Annotate AST nodes with type information and also return a type environment mapping names to type information; provided with a starting type environment.
analyseAndCheckTypesWithEnv :: Data a => TypeEnv -> ProgramFile (Analysis a) -> (ProgramFile (Analysis a), TypeEnv, [TypeError]) Source #
Annotate AST nodes with type information, return a type environment mapping names to type information and return any type errors found; provided with a starting type environment.
extractTypeEnv :: forall a. Data a => ProgramFile (Analysis a) -> TypeEnv Source #
deriveSemTypeFromDeclaration :: (MonadState InferState m, MonadReader InferConfig m) => SrcSpan -> SrcSpan -> TypeSpec a -> Maybe (Expression a) -> m SemType Source #
Attempt to derive the SemType
of a variable from the relevant parts of
its surrounding StDeclaration
.
This is an example of a simple declaration:
INTEGER(8) :: var_name
A declaration holds a TypeSpec
(left of the double colon; LHS) and a list
of Declarator
s (right of the double colon; RHS). However, CHARACTER
variable are allowed to specify their length via special syntax on the RHS:
CHARACTER :: string*10
so to handle that, this function takes that length as a Maybe Expression (as
provided in StDeclaration
).
If a length was defined on both sides, the declaration length (RHS) is used. This matches gfortran's behaviour, though even with -Wall they don't warn on this rather confusing syntax usage. We report a (soft) type error.
deriveSemTypeFromTypeSpec :: MonadState InferState m => TypeSpec a -> m SemType Source #
runInfer :: FortranVersion -> TypeEnv -> Infer a -> (a, InferState) Source #
inferState0 :: FortranVersion -> InferState Source #