-- | This module contains very basic definitions for Futhark - so basic,
-- that they can be shared between the internal and external
-- representation.
module Language.Futhark.Core
  ( Uniqueness (..),
    NoUniqueness (..),

    -- * Location utilities
    SrcLoc,
    Loc,
    Located (..),
    noLoc,
    L (..),
    unLoc,
    srclocOf,
    locStr,
    locStrRel,
    locText,
    locTextRel,
    prettyStacktrace,

    -- * Name handling
    Name,
    nameToString,
    nameFromString,
    nameToText,
    nameFromText,
    VName (..),
    baseTag,
    baseName,
    baseString,
    baseText,
    quote,

    -- * Number re-export
    Int8,
    Int16,
    Int32,
    Int64,
    Word8,
    Word16,
    Word32,
    Word64,
    Half,
  )
where

import Control.Category
import Data.Int (Int16, Int32, Int64, Int8)
import Data.String
import Data.Text qualified as T
import Data.Word (Word16, Word32, Word64, Word8)
import Futhark.Util (showText)
import Futhark.Util.Loc
import Futhark.Util.Pretty
import Numeric.Half
import Prelude hiding (id, (.))

-- | The uniqueness attribute of a type.  This essentially indicates
-- whether or not in-place modifications are acceptable.  With respect
-- to ordering, 'Unique' is greater than 'Nonunique'.
data Uniqueness
  = -- | May have references outside current function.
    Nonunique
  | -- | No references outside current function.
    Unique
  deriving (Uniqueness -> Uniqueness -> Bool
(Uniqueness -> Uniqueness -> Bool)
-> (Uniqueness -> Uniqueness -> Bool) -> Eq Uniqueness
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Uniqueness -> Uniqueness -> Bool
== :: Uniqueness -> Uniqueness -> Bool
$c/= :: Uniqueness -> Uniqueness -> Bool
/= :: Uniqueness -> Uniqueness -> Bool
Eq, Eq Uniqueness
Eq Uniqueness =>
(Uniqueness -> Uniqueness -> Ordering)
-> (Uniqueness -> Uniqueness -> Bool)
-> (Uniqueness -> Uniqueness -> Bool)
-> (Uniqueness -> Uniqueness -> Bool)
-> (Uniqueness -> Uniqueness -> Bool)
-> (Uniqueness -> Uniqueness -> Uniqueness)
-> (Uniqueness -> Uniqueness -> Uniqueness)
-> Ord Uniqueness
Uniqueness -> Uniqueness -> Bool
Uniqueness -> Uniqueness -> Ordering
Uniqueness -> Uniqueness -> Uniqueness
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Uniqueness -> Uniqueness -> Ordering
compare :: Uniqueness -> Uniqueness -> Ordering
$c< :: Uniqueness -> Uniqueness -> Bool
< :: Uniqueness -> Uniqueness -> Bool
$c<= :: Uniqueness -> Uniqueness -> Bool
<= :: Uniqueness -> Uniqueness -> Bool
$c> :: Uniqueness -> Uniqueness -> Bool
> :: Uniqueness -> Uniqueness -> Bool
$c>= :: Uniqueness -> Uniqueness -> Bool
>= :: Uniqueness -> Uniqueness -> Bool
$cmax :: Uniqueness -> Uniqueness -> Uniqueness
max :: Uniqueness -> Uniqueness -> Uniqueness
$cmin :: Uniqueness -> Uniqueness -> Uniqueness
min :: Uniqueness -> Uniqueness -> Uniqueness
Ord, Int -> Uniqueness -> ShowS
[Uniqueness] -> ShowS
Uniqueness -> String
(Int -> Uniqueness -> ShowS)
-> (Uniqueness -> String)
-> ([Uniqueness] -> ShowS)
-> Show Uniqueness
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Uniqueness -> ShowS
showsPrec :: Int -> Uniqueness -> ShowS
$cshow :: Uniqueness -> String
show :: Uniqueness -> String
$cshowList :: [Uniqueness] -> ShowS
showList :: [Uniqueness] -> ShowS
Show)

instance Semigroup Uniqueness where
  <> :: Uniqueness -> Uniqueness -> Uniqueness
(<>) = Uniqueness -> Uniqueness -> Uniqueness
forall a. Ord a => a -> a -> a
min

instance Monoid Uniqueness where
  mempty :: Uniqueness
mempty = Uniqueness
Unique

instance Pretty Uniqueness where
  pretty :: forall ann. Uniqueness -> Doc ann
pretty Uniqueness
Unique = Doc ann
"*"
  pretty Uniqueness
Nonunique = Doc ann
forall a. Monoid a => a
mempty

-- | A fancier name for @()@ - encodes no uniqueness information.
-- Also has a different prettyprinting instance.
data NoUniqueness = NoUniqueness
  deriving (NoUniqueness -> NoUniqueness -> Bool
(NoUniqueness -> NoUniqueness -> Bool)
-> (NoUniqueness -> NoUniqueness -> Bool) -> Eq NoUniqueness
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NoUniqueness -> NoUniqueness -> Bool
== :: NoUniqueness -> NoUniqueness -> Bool
$c/= :: NoUniqueness -> NoUniqueness -> Bool
/= :: NoUniqueness -> NoUniqueness -> Bool
Eq, Eq NoUniqueness
Eq NoUniqueness =>
(NoUniqueness -> NoUniqueness -> Ordering)
-> (NoUniqueness -> NoUniqueness -> Bool)
-> (NoUniqueness -> NoUniqueness -> Bool)
-> (NoUniqueness -> NoUniqueness -> Bool)
-> (NoUniqueness -> NoUniqueness -> Bool)
-> (NoUniqueness -> NoUniqueness -> NoUniqueness)
-> (NoUniqueness -> NoUniqueness -> NoUniqueness)
-> Ord NoUniqueness
NoUniqueness -> NoUniqueness -> Bool
NoUniqueness -> NoUniqueness -> Ordering
NoUniqueness -> NoUniqueness -> NoUniqueness
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: NoUniqueness -> NoUniqueness -> Ordering
compare :: NoUniqueness -> NoUniqueness -> Ordering
$c< :: NoUniqueness -> NoUniqueness -> Bool
< :: NoUniqueness -> NoUniqueness -> Bool
$c<= :: NoUniqueness -> NoUniqueness -> Bool
<= :: NoUniqueness -> NoUniqueness -> Bool
$c> :: NoUniqueness -> NoUniqueness -> Bool
> :: NoUniqueness -> NoUniqueness -> Bool
$c>= :: NoUniqueness -> NoUniqueness -> Bool
>= :: NoUniqueness -> NoUniqueness -> Bool
$cmax :: NoUniqueness -> NoUniqueness -> NoUniqueness
max :: NoUniqueness -> NoUniqueness -> NoUniqueness
$cmin :: NoUniqueness -> NoUniqueness -> NoUniqueness
min :: NoUniqueness -> NoUniqueness -> NoUniqueness
Ord, Int -> NoUniqueness -> ShowS
[NoUniqueness] -> ShowS
NoUniqueness -> String
(Int -> NoUniqueness -> ShowS)
-> (NoUniqueness -> String)
-> ([NoUniqueness] -> ShowS)
-> Show NoUniqueness
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NoUniqueness -> ShowS
showsPrec :: Int -> NoUniqueness -> ShowS
$cshow :: NoUniqueness -> String
show :: NoUniqueness -> String
$cshowList :: [NoUniqueness] -> ShowS
showList :: [NoUniqueness] -> ShowS
Show)

instance Semigroup NoUniqueness where
  NoUniqueness
NoUniqueness <> :: NoUniqueness -> NoUniqueness -> NoUniqueness
<> NoUniqueness
NoUniqueness = NoUniqueness
NoUniqueness

instance Monoid NoUniqueness where
  mempty :: NoUniqueness
mempty = NoUniqueness
NoUniqueness

instance Pretty NoUniqueness where
  pretty :: forall ann. NoUniqueness -> Doc ann
pretty NoUniqueness
_ = Doc ann
forall a. Monoid a => a
mempty

-- | The abstract (not really) type representing names in the Futhark
-- compiler.  'String's, being lists of characters, are very slow,
-- while 'T.Text's are based on byte-arrays.
newtype Name = Name T.Text
  deriving (Int -> Name -> ShowS
[Name] -> ShowS
Name -> String
(Int -> Name -> ShowS)
-> (Name -> String) -> ([Name] -> ShowS) -> Show Name
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Name -> ShowS
showsPrec :: Int -> Name -> ShowS
$cshow :: Name -> String
show :: Name -> String
$cshowList :: [Name] -> ShowS
showList :: [Name] -> ShowS
Show, Name -> Name -> Bool
(Name -> Name -> Bool) -> (Name -> Name -> Bool) -> Eq Name
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Name -> Name -> Bool
== :: Name -> Name -> Bool
$c/= :: Name -> Name -> Bool
/= :: Name -> Name -> Bool
Eq, Eq Name
Eq Name =>
(Name -> Name -> Ordering)
-> (Name -> Name -> Bool)
-> (Name -> Name -> Bool)
-> (Name -> Name -> Bool)
-> (Name -> Name -> Bool)
-> (Name -> Name -> Name)
-> (Name -> Name -> Name)
-> Ord Name
Name -> Name -> Bool
Name -> Name -> Ordering
Name -> Name -> Name
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Name -> Name -> Ordering
compare :: Name -> Name -> Ordering
$c< :: Name -> Name -> Bool
< :: Name -> Name -> Bool
$c<= :: Name -> Name -> Bool
<= :: Name -> Name -> Bool
$c> :: Name -> Name -> Bool
> :: Name -> Name -> Bool
$c>= :: Name -> Name -> Bool
>= :: Name -> Name -> Bool
$cmax :: Name -> Name -> Name
max :: Name -> Name -> Name
$cmin :: Name -> Name -> Name
min :: Name -> Name -> Name
Ord, String -> Name
(String -> Name) -> IsString Name
forall a. (String -> a) -> IsString a
$cfromString :: String -> Name
fromString :: String -> Name
IsString, NonEmpty Name -> Name
Name -> Name -> Name
(Name -> Name -> Name)
-> (NonEmpty Name -> Name)
-> (forall b. Integral b => b -> Name -> Name)
-> Semigroup Name
forall b. Integral b => b -> Name -> Name
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: Name -> Name -> Name
<> :: Name -> Name -> Name
$csconcat :: NonEmpty Name -> Name
sconcat :: NonEmpty Name -> Name
$cstimes :: forall b. Integral b => b -> Name -> Name
stimes :: forall b. Integral b => b -> Name -> Name
Semigroup)

instance Pretty Name where
  pretty :: forall ann. Name -> Doc ann
pretty = String -> Doc ann
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (String -> Doc ann) -> (Name -> String) -> Name -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Name -> String
nameToString

-- | Convert a name to the corresponding list of characters.
nameToString :: Name -> String
nameToString :: Name -> String
nameToString (Name Text
t) = Text -> String
T.unpack Text
t

-- | Convert a list of characters to the corresponding name.
nameFromString :: String -> Name
nameFromString :: String -> Name
nameFromString = Text -> Name
Name (Text -> Name) -> (String -> Text) -> String -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> Text
T.pack

-- | Convert a name to the corresponding 'T.Text'.
nameToText :: Name -> T.Text
nameToText :: Name -> Text
nameToText (Name Text
t) = Text
t

-- | Convert a 'T.Text' to the corresponding name.
nameFromText :: T.Text -> Name
nameFromText :: Text -> Name
nameFromText = Text -> Name
Name

-- | A human-readable location string, of the form
-- @filename:lineno:columnno@.  This follows the GNU coding standards
-- for error messages:
-- https://www.gnu.org/prep/standards/html_node/Errors.html
--
-- This function assumes that both start and end position is in the
-- same file (it is not clear what the alternative would even mean).
locStr :: (Located a) => a -> String
locStr :: forall a. Located a => a -> String
locStr a
a =
  case a -> Loc
forall a. Located a => a -> Loc
locOf a
a of
    Loc
NoLoc -> String
"unknown location"
    Loc (Pos String
file Int
line1 Int
col1 Int
_) (Pos String
_ Int
line2 Int
col2 Int
_)
      -- Do not show line2 if it is identical to line1.
      | Int
line1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
line2 ->
          String
first_part String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"-" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
col2
      | Bool
otherwise ->
          String
first_part String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"-" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
line2 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
col2
      where
        first_part :: String
first_part = String
file String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
line1 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
col1

-- | Like 'locStr', but @locStrRel prev now@ prints the location @now@
-- with the file name left out if the same as @prev@.  This is useful
-- when printing messages that are all in the context of some
-- initially printed location (e.g. the first mention contains the
-- file name; the rest just line and column name).
locStrRel :: (Located a, Located b) => a -> b -> String
locStrRel :: forall a b. (Located a, Located b) => a -> b -> String
locStrRel a
a b
b =
  case (a -> Loc
forall a. Located a => a -> Loc
locOf a
a, b -> Loc
forall a. Located a => a -> Loc
locOf b
b) of
    (Loc (Pos String
a_file Int
_ Int
_ Int
_) Pos
_, Loc (Pos String
b_file Int
line1 Int
col1 Int
_) (Pos String
_ Int
line2 Int
col2 Int
_))
      | String
a_file String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
b_file,
        Int
line1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
line2 ->
          String
first_part String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"-" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
col2
      | String
a_file String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
b_file ->
          String
first_part String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"-" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
line2 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
col2
      where
        first_part :: String
first_part = Int -> String
forall a. Show a => a -> String
show Int
line1 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
col1
    (Loc, Loc)
_ -> b -> String
forall a. Located a => a -> String
locStr b
b

-- | 'locStr', but for text.
locText :: (Located a) => a -> T.Text
locText :: forall a. Located a => a -> Text
locText = String -> Text
T.pack (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> String
forall a. Located a => a -> String
locStr

-- | 'locStrRel', but for text.
locTextRel :: (Located a, Located b) => a -> b -> T.Text
locTextRel :: forall a b. (Located a, Located b) => a -> b -> Text
locTextRel a
a b
b = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ a -> b -> String
forall a b. (Located a, Located b) => a -> b -> String
locStrRel a
a b
b

-- | Given a list of strings representing entries in the stack trace
-- and the index of the frame to highlight, produce a final
-- newline-terminated string for showing to the user.  This string
-- should also be preceded by a newline.  The most recent stack frame
-- must come first in the list.
prettyStacktrace :: Int -> [T.Text] -> T.Text
prettyStacktrace :: Int -> [Text] -> Text
prettyStacktrace Int
cur = [Text] -> Text
T.unlines ([Text] -> Text) -> ([Text] -> [Text]) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Int -> Text -> Text) -> [Int] -> [Text] -> [Text]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> Text -> Text
f [(Int
0 :: Int) ..]
  where
    -- Formatting hack: assume no stack is deeper than 100
    -- elements.  Since Futhark does not support recursion, going
    -- beyond that would require a truly perverse program.
    f :: Int -> Text -> Text
f Int
i Text
x =
      (if Int
cur Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
i then Text
"-> " else Text
"   ")
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"#"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
showText Int
i
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
9 then Text
"" else Text
" ")
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" "
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x

-- | A name tagged with some integer.  Only the integer is used in
-- comparisons, no matter the type of @vn@.
data VName = VName !Name !Int
  deriving (Int -> VName -> ShowS
[VName] -> ShowS
VName -> String
(Int -> VName -> ShowS)
-> (VName -> String) -> ([VName] -> ShowS) -> Show VName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VName -> ShowS
showsPrec :: Int -> VName -> ShowS
$cshow :: VName -> String
show :: VName -> String
$cshowList :: [VName] -> ShowS
showList :: [VName] -> ShowS
Show)

-- | Return the tag contained in the 'VName'.
baseTag :: VName -> Int
baseTag :: VName -> Int
baseTag (VName Name
_ Int
tag) = Int
tag

-- | Return the name contained in the 'VName'.
baseName :: VName -> Name
baseName :: VName -> Name
baseName (VName Name
vn Int
_) = Name
vn

-- | Return the base 'Name' converted to a string.
baseString :: VName -> String
baseString :: VName -> String
baseString = Name -> String
nameToString (Name -> String) -> (VName -> Name) -> VName -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. VName -> Name
baseName

-- | Return the base 'Name' converted to a text.
baseText :: VName -> T.Text
baseText :: VName -> Text
baseText = Name -> Text
nameToText (Name -> Text) -> (VName -> Name) -> VName -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. VName -> Name
baseName

instance Eq VName where
  VName Name
_ Int
x == :: VName -> VName -> Bool
== VName Name
_ Int
y = Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
y

instance Ord VName where
  VName Name
_ Int
x compare :: VName -> VName -> Ordering
`compare` VName Name
_ Int
y = Int
x Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Int
y

-- | Enclose a string in the prefered quotes used in error messages.
-- These are picked to not collide with characters permitted in
-- identifiers.
quote :: T.Text -> T.Text
quote :: Text -> Text
quote Text
s = Text
"\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\""