<commit_before>{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, ScopedTypeVariables #-}
-- | This Is an Ever-Changing AnSyn for L0.  Some types, such as
-- @Exp@, are parametrised by type representation.
-- See "L0.TypeChecker" and the 'Exp' type for more information.
module L0.AbSyn
  ( locStr
  , Uniqueness(..)
  , Type(..)
  , subtypeOf
  , similarTo
  , uniqueness
  , unique
  , TypeBox(..)
  , Typed(..)
  , ppType
  , arrayDims
  , arrayShape
  , peelArray
  , baseType
  , basicType
  , arrayType
  , stripArray
  , blankValue
  , Value(..)
  , arrayVal
  , emptyArray
  , arrayString
  , flattenArray
  , ppValue
  , Ident(..)
  , Exp(..)
  , expToValue
  , ppExp
  , isBuiltInFun
  , BinOp(..)
  , opStr
  , ppBinOp
  , Lambda(..)
  , TupIdent(..)
  , ppTupId
  , FunDec
  , Prog
  , funDecByName
  , progNames
  , prettyPrint
  )
  where

import Data.Array
import Data.Data hiding (typeOf)
import Data.List
import Data.Generics hiding (typeOf)
import Data.Loc
import Data.Monoid

isBuiltInFun :: String -> Bool
isBuiltInFun fnm = fnm `elem` ["toReal", "trunc", "sqrt", "log", "exp", "trace", "assertZip"]

locStr :: SrcLoc -> String
locStr (SrcLoc NoLoc) = "unknown location"
locStr (SrcLoc (Loc (Pos file line1 col1 _) (Pos _ line2 col2 _))) =
  -- Assume that both positions are in the same file (what would the
  -- alternative mean?)
  file ++ ":" ++ show line1 ++ ":" ++ show col1
       ++ "-" ++ show line2 ++ ":" ++ show col2

data Uniqueness = Unique | Nonunique
                  deriving (Eq, Ord, Show, Typeable, Data)

instance Monoid Uniqueness where
  mempty = Unique
  _ `mappend` Nonunique = Nonunique
  Nonunique `mappend` _ = Nonunique
  u `mappend` _         = u

-- | L0 Types: Int, Bool, Char, Tuple, multidim-regular Array
--  TODO: please add float, double, long int, etc.
data Type = Int SrcLoc
          | Bool SrcLoc
          | Char SrcLoc
          | Real SrcLoc
          | Tuple [Type] SrcLoc
          | Array Type (Maybe (Exp (Maybe Type))) Uniqueness SrcLoc -- ^ 1st arg: array's element type, 2nd arg: its length
            deriving (Eq, Ord, Show, Typeable, Data)

instance Located Type where
  locOf (Int loc) = locOf loc
  locOf (Bool loc) = locOf loc
  locOf (Char loc) = locOf loc
  locOf (Real loc) = locOf loc
  locOf (Tuple _ loc) = locOf loc
  locOf (Array _ _ _ loc) = locOf loc

-- | Return the dimensionality of a type.  For non-arrays, this is
-- zero.  For a one-dimensional array it is one, for a two-dimensional
-- it is two, and so forth.
arrayDims :: Type -> Int
arrayDims (Array t _ _ _) = 1 + arrayDims t
arrayDims _               = 0

-- | @x `subuniqueOf` y@ is true if @x@ is not less unique than @y@.
subuniqueOf :: Uniqueness -> Uniqueness -> Bool
subuniqueOf Nonunique Unique = False
subuniqueOf _ _ = True

-- | @x \`subtypeOf\` y@ is true if @x@ is a subtype of @y@ (or equal to
-- @y@), meaning @x@ is valid whenever @y@ is.
subtypeOf :: Type -> Type -> Bool
subtypeOf (Array t1 _ u1 _) (Array t2 _ u2 _) =
  u1 `subuniqueOf` u2 && t1 `subtypeOf` t2
subtypeOf t1 t2 = t1 == t2

-- | @x \`similarTo\` y@ is true if @x@ and @y@ are the same type,
-- ignoring uniqueness.
similarTo :: Type -> Type -> Bool
similarTo t1 t2 = t1 `subtypeOf` t2 || t2 `subtypeOf` t1

-- | Return the uniqueness of a type.
uniqueness :: Typed a => a -> Uniqueness
uniqueness = uniqueness' . typeOf
  where uniqueness' (Array _ _ u _) = u
        uniqueness' _ = Nonunique

-- | @unique t@ is 'True' if the type of the argument is unique.
unique :: Typed a => a -> Bool
unique = (==Unique) . uniqueness

-- | A type box provides a way to box a type, and possibly retrieve
-- one.
class (Eq ty, Ord ty, Show ty, Data ty, Typeable ty) => TypeBox ty where
  unboxType :: ty -> Maybe Type
  boxType :: Type -> ty
  getExpType :: Exp ty -> ty

instance TypeBox (Maybe Type) where
  unboxType = id
  boxType = Just
  getExpType _ = Nothing

instance TypeBox Type where
  unboxType = Just
  boxType = id
  getExpType = typeOf

-- | A typed value is one from which we can retrieve a type.
class Typed v where
  typeOf :: v -> Type

instance Typed Type where
  typeOf = id

-- | @peelArray n t@ returns the type resulting from peeling the first
-- @n@ array dimensions from @t@.  Returns @Nothing@ if @t@ has less
-- than @n@ dimensions.
peelArray :: Int -> Type -> Maybe Type
peelArray 0 t = Just t
peelArray n (Array t _ _ _) = peelArray (n-1) t
peelArray _ _ = Nothing

-- | Returns the bottommost type of an array.
baseType :: Type -> Type
baseType (Array t _ _ _) = baseType t
baseType t = t

-- | A type is a basic type if it is not an array and any component
-- types are basic types.
basicType :: Type -> Bool
basicType (Array {}) = False
basicType (Tuple ts _) = all basicType ts
basicType _ = True

uniqueOrBasic :: Typed t => t -> Bool
uniqueOrBasic x = basicType (typeOf x) || unique x

-- | @array n t@ is the type of @n@-dimensional arrays having @t@ as
-- the base type.
arrayType :: Int -> Type -> Uniqueness -> Type
arrayType 0 t _ = t
arrayType n t u = arrayType (n-1) (Array t Nothing u (srclocOf t)) u

-- | @stripArray n t@ removes the @n@ outermost layers of the array.
-- Essentially, it is the type of indexing an array of type @t@ with
-- @n@ indexes.
stripArray :: Int -> Type -> Type
stripArray 0 t = t
stripArray n (Array t _ _ _) = stripArray (n-1) t
stripArray _ t = t

withUniqueness :: Type -> Uniqueness -> Type
withUniqueness (Array et dims _ loc) u = Array et dims u loc
withUniqueness t _ = t

-- | A "blank" value of the given type - this is zero, or whatever is
-- close to it.  Don't depend on this value, but use it for creating
-- arrays to be populated by do-loops.
blankValue :: Type -> Value
blankValue (Int _) = IntVal 0
blankValue (Real _) = RealVal 0.0
blankValue (Bool _) = LogVal False
blankValue (Char _) = CharVal '\0'
blankValue (Tuple ts _) = TupVal (map blankValue ts)
blankValue (Array et _ _ _) = arrayVal [blankValue et] et

-- | Every possible value in L0.  Values are fully evaluated and their
-- type is always unambiguous.
data Value = IntVal !Int
           | RealVal !Double
           | LogVal !Bool
           | CharVal !Char
           | TupVal ![Value]
           | ArrayVal !(Array Int Value) Type
             -- ^ The type is the element type, not the complete array
             -- type.  It is assumed that the array is 0-indexed.
             deriving (Eq, Ord, Show, Typeable, Data)

instance Typed Value where
  typeOf (IntVal _) = Int noLoc
  typeOf (RealVal _) = Real noLoc
  typeOf (LogVal _) = Bool noLoc
  typeOf (CharVal _) = Char noLoc
  typeOf (TupVal vs) = Tuple (map typeOf vs) noLoc<commit_msg>Oops, these cases are still necessary for tuples.<commit_after>{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, ScopedTypeVariables #-}
-- | This Is an Ever-Changing AnSyn for L0.  Some types, such as
-- @Exp@, are parametrised by type representation.
-- See "L0.TypeChecker" and the 'Exp' type for more information.
module L0.AbSyn
  ( locStr
  , Uniqueness(..)
  , Type(..)
  , subtypeOf
  , similarTo
  , uniqueness
  , unique
  , TypeBox(..)
  , Typed(..)
  , ppType
  , arrayDims
  , arrayShape
  , peelArray
  , baseType
  , basicType
  , arrayType
  , stripArray
  , blankValue
  , Value(..)
  , arrayVal
  , emptyArray
  , arrayString
  , flattenArray
  , ppValue
  , Ident(..)
  , Exp(..)
  , expToValue
  , ppExp
  , isBuiltInFun
  , BinOp(..)
  , opStr
  , ppBinOp
  , Lambda(..)
  , TupIdent(..)
  , ppTupId
  , FunDec
  , Prog
  , funDecByName
  , progNames
  , prettyPrint
  )
  where

import Data.Array
import Data.Data hiding (typeOf)
import Data.List
import Data.Generics hiding (typeOf)
import Data.Loc
import Data.Monoid

isBuiltInFun :: String -> Bool
isBuiltInFun fnm = fnm `elem` ["toReal", "trunc", "sqrt", "log", "exp", "trace", "assertZip"]

locStr :: SrcLoc -> String
locStr (SrcLoc NoLoc) = "unknown location"
locStr (SrcLoc (Loc (Pos file line1 col1 _) (Pos _ line2 col2 _))) =
  -- Assume that both positions are in the same file (what would the
  -- alternative mean?)
  file ++ ":" ++ show line1 ++ ":" ++ show col1
       ++ "-" ++ show line2 ++ ":" ++ show col2

data Uniqueness = Unique | Nonunique
                  deriving (Eq, Ord, Show, Typeable, Data)

instance Monoid Uniqueness where
  mempty = Unique
  _ `mappend` Nonunique = Nonunique
  Nonunique `mappend` _ = Nonunique
  u `mappend` _         = u

-- | L0 Types: Int, Bool, Char, Tuple, multidim-regular Array
--  TODO: please add float, double, long int, etc.
data Type = Int SrcLoc
          | Bool SrcLoc
          | Char SrcLoc
          | Real SrcLoc
          | Tuple [Type] SrcLoc
          | Array Type (Maybe (Exp (Maybe Type))) Uniqueness SrcLoc -- ^ 1st arg: array's element type, 2nd arg: its length
            deriving (Eq, Ord, Show, Typeable, Data)

instance Located Type where
  locOf (Int loc) = locOf loc
  locOf (Bool loc) = locOf loc
  locOf (Char loc) = locOf loc
  locOf (Real loc) = locOf loc
  locOf (Tuple _ loc) = locOf loc
  locOf (Array _ _ _ loc) = locOf loc

-- | Return the dimensionality of a type.  For non-arrays, this is
-- zero.  For a one-dimensional array it is one, for a two-dimensional
-- it is two, and so forth.
arrayDims :: Type -> Int
arrayDims (Array t _ _ _) = 1 + arrayDims t
arrayDims _               = 0

-- | @x `subuniqueOf` y@ is true if @x@ is not less unique than @y@.
subuniqueOf :: Uniqueness -> Uniqueness -> Bool
subuniqueOf Nonunique Unique = False
subuniqueOf _ _ = True

-- | @x \`subtypeOf\` y@ is true if @x@ is a subtype of @y@ (or equal to
-- @y@), meaning @x@ is valid whenever @y@ is.
subtypeOf :: Type -> Type -> Bool
subtypeOf (Array t1 _ u1 _) (Array t2 _ u2 _) =
  u1 `subuniqueOf` u2 && t1 `subtypeOf` t2
subtypeOf (Tuple ts1 _) (Tuple ts2 _) =
  and $ zipWith subtypeOf ts1 ts2
subtypeOf t1 t2 = t1 == t2

-- | @x \`similarTo\` y@ is true if @x@ and @y@ are the same type,
-- ignoring uniqueness.
similarTo :: Type -> Type -> Bool
similarTo t1 t2 = t1 `subtypeOf` t2 || t2 `subtypeOf` t1

-- | Return the uniqueness of a type.
uniqueness :: Typed a => a -> Uniqueness
uniqueness = uniqueness' . typeOf
  where uniqueness' (Array _ _ u _) = u
        uniqueness' _ = Nonunique

-- | @unique t@ is 'True' if the type of the argument is unique.
unique :: Typed a => a -> Bool
unique = (==Unique) . uniqueness

-- | A type box provides a way to box a type, and possibly retrieve
-- one.
class (Eq ty, Ord ty, Show ty, Data ty, Typeable ty) => TypeBox ty where
  unboxType :: ty -> Maybe Type
  boxType :: Type -> ty
  getExpType :: Exp ty -> ty

instance TypeBox (Maybe Type) where
  unboxType = id
  boxType = Just
  getExpType _ = Nothing

instance TypeBox Type where
  unboxType = Just
  boxType = id
  getExpType = typeOf

-- | A typed value is one from which we can retrieve a type.
class Typed v where
  typeOf :: v -> Type

instance Typed Type where
  typeOf = id

-- | @peelArray n t@ returns the type resulting from peeling the first
-- @n@ array dimensions from @t@.  Returns @Nothing@ if @t@ has less
-- than @n@ dimensions.
peelArray :: Int -> Type -> Maybe Type
peelArray 0 t = Just t
peelArray n (Array t _ _ _) = peelArray (n-1) t
peelArray _ _ = Nothing

-- | Returns the bottommost type of an array.
baseType :: Type -> Type
baseType (Array t _ _ _) = baseType t
baseType t = t

-- | A type is a basic type if it is not an array and any component
-- types are basic types.
basicType :: Type -> Bool
basicType (Array {}) = False
basicType (Tuple ts _) = all basicType ts
basicType _ = True

uniqueOrBasic :: Typed t => t -> Bool
uniqueOrBasic x = basicType (typeOf x) || unique x

-- | @array n t@ is the type of @n@-dimensional arrays having @t@ as
-- the base type.
arrayType :: Int -> Type -> Uniqueness -> Type
arrayType 0 t _ = t
arrayType n t u = arrayType (n-1) (Array t Nothing u (srclocOf t)) u

-- | @stripArray n t@ removes the @n@ outermost layers of the array.
-- Essentially, it is the type of indexing an array of type @t@ with
-- @n@ indexes.
stripArray :: Int -> Type -> Type
stripArray 0 t = t
stripArray n (Array t _ _ _) = stripArray (n-1) t
stripArray _ t = t

withUniqueness :: Type -> Uniqueness -> Type
withUniqueness (Array et dims _ loc) u = Array et dims u loc
withUniqueness (Tuple ets loc) u = Tuple (map (`withUniqueness` u) ets) loc
withUniqueness t _ = t

-- | A "blank" value of the given type - this is zero, or whatever is
-- close to it.  Don't depend on this value, but use it for creating
-- arrays to be populated by do-loops.
blankValue :: Type -> Value
blankValue (Int _) = IntVal 0
blankValue (Real _) = RealVal 0.0
blankValue (Bool _) = LogVal False
blankValue (Char _) = CharVal '\0'
blankValue (Tuple ts _) = TupVal (map blankValue ts)
blankValue (Array et _ _ _) = arrayVal [blankValue et] et

-- | Every possible value in L0.  Values are fully evaluated and their
-- type is always unambiguous.
data Value = IntVal !Int
           | RealVal !Double
           | LogVal !Bool
           | CharVal !Char
           | TupVal ![Value]
           | ArrayVal !(Array Int Value) Type
             -- ^ The type is the element type, not the complete array
             -- type.  It is assumed that the array is 0-indexed.
             deriving (Eq, Ord, Show, Typeable, Data)

instance Typed Value where
  typeOf (IntVal _) = Int noLoc
  typeOf (RealVal _) = Real noLoc
  typeOf (LogVal _) = Bool noLoc
  typeOf (CharVal _) = Char noLoc
  typeOf (TupVal vs) = Tuple (map typeOf vs) noLoc
{'fraction_non_alphanumeric': 0.1109375, 'fraction_numerical': 0.007142857142857143, 'mean_word_length': 2.8065703766638346, 'pattern_counts': {'":': 6, '<': 3, '<?xml version=': 0, '>': 67, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '4177386', 'n_tokens_mistral': 4611, 'n_tokens_neox': 4516, 'n_words': 1771}