blob: 1a344e9d7bb8d836476de7bf88140c51db4a6a0a [file] [log] [blame]
--
-- Copyright 2019, Data61
-- Commonwealth Scientific and Industrial Research Organisation (CSIRO)
-- ABN 41 687 119 230.
--
-- This software may be distributed and modified according to the terms of
-- the GNU General Public License version 2. Note that NO WARRANTY is provided.
-- See "LICENSE_GPLv2.txt" for details.
--
-- @TAG(DATA61_GPL)
--
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveTraversable #-}
module Cogent.Common.Types where
import Cogent.Common.Syntax
import Cogent.Compiler
import Data.Binary (Binary)
import Data.Data
import Data.Map as M
#if __GLASGOW_HASKELL__ < 709
import Data.Monoid
#endif
import GHC.Generics (Generic)
import Text.PrettyPrint.ANSI.Leijen hiding (tupled,indent)
type ReadOnly = Bool -- True for r/o
data Sigil r = Boxed ReadOnly r -- 0- or 1-kinded
| Unboxed -- 2-kinded
deriving (Show, Data, Eq, Ord, Foldable, Functor, Generic, Traversable)
instance Binary r => Binary (Sigil r)
data RecursiveParameter = Rec VarName | NonRec deriving (Data, Show, Eq, Ord, Generic)
-- The context for a recursive type, i.e. a mapping from
-- recursive parameter names to the type it recursively references
type RecContext t = Maybe (M.Map RecParName t)
instance Binary RecursiveParameter
bangSigil :: Sigil r -> Sigil r
bangSigil (Boxed _ r) = Boxed True r
bangSigil Unboxed = Unboxed
unboxSigil :: Sigil r -> Sigil r
unboxSigil _ = Unboxed
writable :: Sigil r -> Bool
writable (Boxed False _) = True
writable _ = False
readonly :: Sigil r -> Bool
readonly (Boxed True _) = True
readonly _ = False
unboxed :: Sigil r -> Bool
unboxed Unboxed = True
unboxed _ = False
data PrimInt = U8 | U16 | U32 | U64 | Boolean deriving (Show, Data, Eq, Ord, Generic)
instance Binary PrimInt
machineWordType :: PrimInt
machineWordType = case __cogent_arch of
ARM32 -> U32
X86_32 -> U32
X86_64 -> U64
primIntSizeBits :: PrimInt -> Size
primIntSizeBits U8 = 8
primIntSizeBits U16 = 16
primIntSizeBits U32 = 32
primIntSizeBits U64 = 64
primIntSizeBits Boolean = 8
isSubtypePrim :: PrimInt -> PrimInt -> Bool
isSubtypePrim U8 U8 = True
isSubtypePrim U8 U16 = True
isSubtypePrim U8 U32 = True
isSubtypePrim U8 U64 = True
isSubtypePrim U16 U16 = True
isSubtypePrim U16 U32 = True
isSubtypePrim U16 U64 = True
isSubtypePrim U32 U32 = True
isSubtypePrim U32 U64 = True
isSubtypePrim U64 U64 = True
isSubtypePrim Boolean Boolean = True
isSubtypePrim _ _ = False
instance Pretty PrimInt where
pretty = blue . bold . string . show
data Kind = K { canEscape :: Bool, canShare :: Bool, canDiscard :: Bool }
deriving (Show, Data, Eq, Ord)
sigilKind :: Sigil r -> Kind
sigilKind (Boxed ro _) = if ro then k0 else k1
sigilKind Unboxed = k2
k0, k1, k2 :: Kind
k0 = K False True True
k1 = K True False False
k2 = mempty
-- kAll = K False False False
#if __GLASGOW_HASKELL__ < 803
instance Monoid Kind where
mempty = K True True True -- 2-kind
mappend (K a b c) (K a' b' c') = K (a && a') (b && b') (c && c')
-- mappend ka 0 1 2
-- kb +-----------------
-- 0 | 0 1x 0
-- 1 | - 1 1
-- 2 | - - 2
-- ! | 0 0 2
-- 1x is a non-escapable linear kind
#else
instance Semigroup Kind where
K a b c <> K a' b' c' = K (a && a') (b && b') (c && c')
instance Monoid Kind where
mempty = K True True True
#endif
bangKind :: Kind -> Kind
bangKind (K e s d) = K (e && s && d) True True
primTypeCons :: [TypeName]
primTypeCons = words "U8 U16 U32 U64 Bool String"