<commit_before>{-# OPTIONS_GHC -fwarn-incomplete-patterns #-}
module Types(
             Type
            ,Activity (..)
            ,arrowType
            ,arrowWithTypeParam
            ,isArrowType
            ,futureType
            ,isFutureType
            ,parType
            ,isParType
            ,streamType
            ,isStreamType
            ,rangeType
            ,arrayType
            ,isArrayType
            ,isRangeType
            ,refTypeWithParams
            ,refType
            ,traitTypeFromRefType
            ,abstractTraitFromTraitType
            ,classType
            ,isRefAtomType
            ,isRefType
            ,isTraitType
            ,isAbstractTraitType
            ,isActiveClassType
            ,isSharedClassType
            ,isPassiveClassType
            ,isClassType
            ,isMainType
            ,stringObjectType
            ,isStringObjectType
            ,conjunctiveType
            ,isConjunctiveType
            ,isDisjunctiveType
            ,getTypeOperands
            ,disjunctiveType
            ,isCapabilityType
            ,incapability
            ,isIncapability
            ,unionType
            ,isUnionType
            ,unionMembers
            ,typeVar
            ,isTypeVar
            ,replaceTypeVars
            ,ctype
            ,isCType
            ,voidType
            ,isVoidType
            ,nullType
            ,isNullType
            ,boolType
            ,isBoolType
            ,intType
            ,isIntType
            ,uintType
            ,isUIntType
            ,realType
            ,isRealType
            ,charType
            ,isCharType
            ,stringType
            ,isStringType
            ,isPrimitive
            ,isNumeric
            ,getTypeParams
            ,getArgTypes
            ,setArgTypes
            ,getResultType
            ,getId
            ,maybeGetId
            ,getRefNamespace
            ,setRefNamespace
            ,getRefSourceFile
            ,setRefSourceFile
            ,translateTypeNamespace
            ,getTypeParameters
            ,setTypeParameters
            ,conjunctiveTypesFromCapability
            ,typesFromCapability
            ,typeComponents
            ,typeMap
            ,typeMapM
            ,showWithKind
            ,hasSameKind
            ,maybeType
            ,isMaybeType
            ,tupleType
            ,isTupleType
            ,bottomType
            ,isBottomType
            ,hasResultType
            ,setResultType
            ,isPrintable
            ,typeSynonym
            ,isTypeSynonym
            ,typeSynonymLHS
            ,typeSynonymRHS
            ,typeSynonymSetRHS
            ,unfoldTypeSynonyms
            ,getTypeParameterBindings
            ) where

import Identifiers

import Data.List
import Data.Maybe
import Data.Map.Strict(Map)
import qualified Data.Map.Strict as Map
import Data.Foldable (toList)
import Data.Traversable
import Text.Parsec.Pos as P

import Debug.Trace

data Activity = Active
              | Shared
              | Passive
                deriving(Eq, Show)

data TypeOp = Product | Addition
  deriving (Eq)

instance Show TypeOp where
  show Product = "*"
  show Addition = "+"

data RefInfo = RefInfo{refId         :: String
                      ,parameters    :: [Type]
                      ,refNamespace  :: Maybe Namespace
                      ,refSourceFile :: Maybe SourceName
                      } deriving(Eq)

instance Show RefInfo where
    show RefInfo{refId, parameters, refNamespace}
        | null parameters = fullName refNamespace refId
        | otherwise = fullName refNamespace refId ++ "<" ++ params ++ ">"
        where
          fullName Nothing refId = refId
          fullName (Just ns) refId =
              if isEmptyNamespace ns
              then refId
              else show ns ++ "." ++ refId
          params = intercalate ", " (map show parameters)

data Type = Unresolved{refInfo :: RefInfo}
          | TraitType{refInfo :: RefInfo}
          -- | The @AbstractTraitType@ is used to type @this@ when
          -- overriding methods. A class that implements a trait
          -- @T@ and overrides one of its methods @m@ will
          -- typecheck @m@ with @this@ as the *abstract* trait
          -- @T@. This is to be able to distinguish e.g. method
          -- parameters that have the type @T@ from the included
          -- trait @T@, which might have been extended with
          -- additional attributes.
          | AbstractTraitType{refInfo :: RefInfo}
          | ClassType{refInfo :: RefInfo
                     ,activity   :: Activity
                     }
          | CapabilityType{typeop :: TypeOp
                          ,ltype  :: Type
                          ,rtype  :: Type}
          | UnionType{ltype :: Type, rtype :: Type}
          | EmptyCapability{}
          | TypeVar{ident :: String}
          | ArrowType{paramTypes :: [Type]
                     ,argTypes   :: [Type]
                     ,resultType :: Type
                     }
          | FutureType{resultType :: Type}
          | ParType{resultType :: Type}
          | StreamType{resultType :: Type}
          | ArrayType{resultType :: Type}
          | RangeType
          | MaybeType {resultType :: Type}
          | TupleType {argTypes :: [Type]}
          | CType{ident :: String}
          | TypeSynonym{refInfo :: RefInfo, resolvesTo :: Type}
          | VoidType
          | StringType
          | CharType
          | IntType
          | UIntType
          | BoolType
          | RealType
          | NullType
          | BottomType
            deriving(Eq)

hasResultType x
  | isArrowType x || isFutureType x || isParType x ||
    isStreamType x || isArrayType x || isMaybeType x = True
  | otherwise = False

setResultType ty res
  | hasResultType ty = ty { resultType = res}
  | otherwise = error $ "Types.hs: tried to set the resultType of " ++ show ty

getTypeParams = paramTypes

getArgTypes = argTypes
setArgTypes ty argTypes = ty{argTypes}

getResultType ty
    | hasResultType ty = resultType ty
    | otherwise = error $ "Types.hs: tried to get the resultType of " ++ show ty

getId ty = case maybeGetId ty of
     Nothing -> error $ "Types.hs: Tried to get the ID of " ++ showWithKind ty
     Just t -> t

getRefNamespace ty
    | isRefAtomType ty || isTypeSynonym ty = refNamespace (refInfo ty)
    | otherwise = error $ "Types.hs: tried to get the namespace of " ++ show ty

setRefNamespace ns ty
    | isRefAtomType ty || isTypeSynonym ty
    , info <- refInfo ty = ty{refInfo = info{refNamespace = Just ns}}
    | otherwise = error $ "Types.hs: tried to set the namespace of " ++ show ty

getRefSourceFile ty
    | isRefAtomType ty || isTypeSynonym ty =
        fromMaybe err $ refSourceFile (refInfo ty)
    | otherwise = error $ "Types.hs: tried to get the sourcefile of " ++ showWithKind ty
    where err = error "Types.hs: type without sourceFile: " ++ showWithKind ty

setRefSourceFile file ty
    | isRefAtomType ty || isTypeSynonym ty
    , info <- refInfo ty = ty{refInfo = info{refSourceFile = Just file}}
    | otherwise = error $ "Types.hs: tried to set the source of " ++ show ty

hasRefSourceFile ty
    | isRefAtomType ty || isTypeSynonym ty
    , info <- refInfo ty = isJust $ refSourceFile info
    | otherwise = False

translateTypeNamespace :: Map SourceName Namespace -> Type -> Type
translateTypeNamespace table = typeMap translate
    where
      translate ty
        | hasRefSourceFile ty =
            let source = getRefSourceFile ty
            in case Map.lookup source table of
                 Just ns -> setRefNamespace ns ty
                 Nothing -> ty
        | otherwise = ty

maybeGetId Unresolved{refInfo} = Just $ refId refInfo
maybeGetId TraitType{refInfo} = Just $ refId refInfo
maybeGetId AbstractTraitType{refInfo} = Just $ refId refInfo
maybeGetId ClassType{refInfo} = Just $ refId refInfo
maybeGetId TypeSynonym{refInfo} = Just $ refId refInfo
maybeGetId TypeVar{ident} = Just $ ident
maybeGetId CType{ident} = Just $ ident
maybeGetId _ = Nothing

instance Show Type where
    show Unresolved{refInfo} = show refInfo
    show TraitType{refInfo} = show refInfo
    show AbstractTraitType{refInfo} = show refInfo
    show ClassType{refInfo} = show refInfo<commit_msg>Crash don't trash when finding unknown source<commit_after>{-# OPTIONS_GHC -fwarn-incomplete-patterns #-}
module Types(
             Type
            ,Activity (..)
            ,arrowType
            ,arrowWithTypeParam
            ,isArrowType
            ,futureType
            ,isFutureType
            ,parType
            ,isParType
            ,streamType
            ,isStreamType
            ,rangeType
            ,arrayType
            ,isArrayType
            ,isRangeType
            ,refTypeWithParams
            ,refType
            ,traitTypeFromRefType
            ,abstractTraitFromTraitType
            ,classType
            ,isRefAtomType
            ,isRefType
            ,isTraitType
            ,isAbstractTraitType
            ,isActiveClassType
            ,isSharedClassType
            ,isPassiveClassType
            ,isClassType
            ,isMainType
            ,stringObjectType
            ,isStringObjectType
            ,conjunctiveType
            ,isConjunctiveType
            ,isDisjunctiveType
            ,getTypeOperands
            ,disjunctiveType
            ,isCapabilityType
            ,incapability
            ,isIncapability
            ,unionType
            ,isUnionType
            ,unionMembers
            ,typeVar
            ,isTypeVar
            ,replaceTypeVars
            ,ctype
            ,isCType
            ,voidType
            ,isVoidType
            ,nullType
            ,isNullType
            ,boolType
            ,isBoolType
            ,intType
            ,isIntType
            ,uintType
            ,isUIntType
            ,realType
            ,isRealType
            ,charType
            ,isCharType
            ,stringType
            ,isStringType
            ,isPrimitive
            ,isNumeric
            ,getTypeParams
            ,getArgTypes
            ,setArgTypes
            ,getResultType
            ,getId
            ,maybeGetId
            ,getRefNamespace
            ,setRefNamespace
            ,getRefSourceFile
            ,setRefSourceFile
            ,translateTypeNamespace
            ,getTypeParameters
            ,setTypeParameters
            ,conjunctiveTypesFromCapability
            ,typesFromCapability
            ,typeComponents
            ,typeMap
            ,typeMapM
            ,showWithKind
            ,hasSameKind
            ,maybeType
            ,isMaybeType
            ,tupleType
            ,isTupleType
            ,bottomType
            ,isBottomType
            ,hasResultType
            ,setResultType
            ,isPrintable
            ,typeSynonym
            ,isTypeSynonym
            ,typeSynonymLHS
            ,typeSynonymRHS
            ,typeSynonymSetRHS
            ,unfoldTypeSynonyms
            ,getTypeParameterBindings
            ) where

import Identifiers

import Data.List
import Data.Maybe
import Data.Map.Strict(Map)
import qualified Data.Map.Strict as Map
import Data.Foldable (toList)
import Data.Traversable
import Text.Parsec.Pos as P

import Debug.Trace

data Activity = Active
              | Shared
              | Passive
                deriving(Eq, Show)

data TypeOp = Product | Addition
  deriving (Eq)

instance Show TypeOp where
  show Product = "*"
  show Addition = "+"

data RefInfo = RefInfo{refId         :: String
                      ,parameters    :: [Type]
                      ,refNamespace  :: Maybe Namespace
                      ,refSourceFile :: Maybe SourceName
                      } deriving(Eq)

instance Show RefInfo where
    show RefInfo{refId, parameters, refNamespace}
        | null parameters = fullName refNamespace refId
        | otherwise = fullName refNamespace refId ++ "<" ++ params ++ ">"
        where
          fullName Nothing refId = refId
          fullName (Just ns) refId =
              if isEmptyNamespace ns
              then refId
              else show ns ++ "." ++ refId
          params = intercalate ", " (map show parameters)

data Type = Unresolved{refInfo :: RefInfo}
          | TraitType{refInfo :: RefInfo}
          -- | The @AbstractTraitType@ is used to type @this@ when
          -- overriding methods. A class that implements a trait
          -- @T@ and overrides one of its methods @m@ will
          -- typecheck @m@ with @this@ as the *abstract* trait
          -- @T@. This is to be able to distinguish e.g. method
          -- parameters that have the type @T@ from the included
          -- trait @T@, which might have been extended with
          -- additional attributes.
          | AbstractTraitType{refInfo :: RefInfo}
          | ClassType{refInfo :: RefInfo
                     ,activity   :: Activity
                     }
          | CapabilityType{typeop :: TypeOp
                          ,ltype  :: Type
                          ,rtype  :: Type}
          | UnionType{ltype :: Type, rtype :: Type}
          | EmptyCapability{}
          | TypeVar{ident :: String}
          | ArrowType{paramTypes :: [Type]
                     ,argTypes   :: [Type]
                     ,resultType :: Type
                     }
          | FutureType{resultType :: Type}
          | ParType{resultType :: Type}
          | StreamType{resultType :: Type}
          | ArrayType{resultType :: Type}
          | RangeType
          | MaybeType {resultType :: Type}
          | TupleType {argTypes :: [Type]}
          | CType{ident :: String}
          | TypeSynonym{refInfo :: RefInfo, resolvesTo :: Type}
          | VoidType
          | StringType
          | CharType
          | IntType
          | UIntType
          | BoolType
          | RealType
          | NullType
          | BottomType
            deriving(Eq)

hasResultType x
  | isArrowType x || isFutureType x || isParType x ||
    isStreamType x || isArrayType x || isMaybeType x = True
  | otherwise = False

setResultType ty res
  | hasResultType ty = ty { resultType = res}
  | otherwise = error $ "Types.hs: tried to set the resultType of " ++ show ty

getTypeParams = paramTypes

getArgTypes = argTypes
setArgTypes ty argTypes = ty{argTypes}

getResultType ty
    | hasResultType ty = resultType ty
    | otherwise = error $ "Types.hs: tried to get the resultType of " ++ show ty

getId ty = case maybeGetId ty of
     Nothing -> error $ "Types.hs: Tried to get the ID of " ++ showWithKind ty
     Just t -> t

getRefNamespace ty
    | isRefAtomType ty || isTypeSynonym ty = refNamespace (refInfo ty)
    | otherwise = error $ "Types.hs: tried to get the namespace of " ++ show ty

setRefNamespace ns ty
    | isRefAtomType ty || isTypeSynonym ty
    , info <- refInfo ty = ty{refInfo = info{refNamespace = Just ns}}
    | otherwise = error $ "Types.hs: tried to set the namespace of " ++ show ty

getRefSourceFile ty
    | isRefAtomType ty || isTypeSynonym ty =
        fromMaybe err $ refSourceFile (refInfo ty)
    | otherwise = error $ "Types.hs: tried to get the sourcefile of " ++ showWithKind ty
    where err = error "Types.hs: type without sourceFile: " ++ showWithKind ty

setRefSourceFile file ty
    | isRefAtomType ty || isTypeSynonym ty
    , info <- refInfo ty = ty{refInfo = info{refSourceFile = Just file}}
    | otherwise = error $ "Types.hs: tried to set the source of " ++ show ty

hasRefSourceFile ty
    | isRefAtomType ty || isTypeSynonym ty
    , info <- refInfo ty = isJust $ refSourceFile info
    | otherwise = False

translateTypeNamespace :: Map SourceName Namespace -> Type -> Type
translateTypeNamespace table = typeMap translate
    where
      translate ty
        | hasRefSourceFile ty =
            let source = getRefSourceFile ty
            in case Map.lookup source table of
                 Just ns -> setRefNamespace ns ty
                 Nothing ->
                   error $ "Types.hs: Type '" ++ show ty ++
                           "' has unknown source '" ++ show source ++ "'"
        | otherwise = ty

maybeGetId Unresolved{refInfo} = Just $ refId refInfo
maybeGetId TraitType{refInfo} = Just $ refId refInfo
maybeGetId AbstractTraitType{refInfo} = Just $ refId refInfo
maybeGetId ClassType{refInfo} = Just $ refId refInfo
maybeGetId TypeSynonym{refInfo} = Just $ refId refInfo
maybeGetId TypeVar{ident} = Just $ ident
maybeGetId CType{ident} = Just $ ident
maybeGetId _ = Nothing

instance Show Type where
    show Unresolved{refInfo} = show refInfo
    show TraitType{refInfo} = show refInfo
    show AbstractTraitType{refInfo} = show refInfo
    show ClassType{refInfo} = show refInfo
{'fraction_non_alphanumeric': 0.07027381733579909, 'fraction_numerical': 0.0, 'mean_word_length': 1.6796675191815857, 'pattern_counts': {'":': 0, '<': 11, '<?xml version=': 0, '>': 17, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 1, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '3261753', 'n_tokens_mistral': 4447, 'n_tokens_neox': 4382, 'n_words': 1244}