-- | 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 (..),

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

    -- * Name handling
    Name,
    nameToString,
    nameFromString,
    nameToText,
    nameFromText,
    VName (..),
    baseTag,
    baseName,
    baseString,
    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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Uniqueness -> Uniqueness -> Bool
$c/= :: Uniqueness -> Uniqueness -> Bool
== :: Uniqueness -> Uniqueness -> Bool
$c== :: Uniqueness -> Uniqueness -> Bool
Eq, Eq 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
min :: Uniqueness -> Uniqueness -> Uniqueness
$cmin :: Uniqueness -> Uniqueness -> Uniqueness
max :: Uniqueness -> Uniqueness -> Uniqueness
$cmax :: Uniqueness -> Uniqueness -> Uniqueness
>= :: Uniqueness -> Uniqueness -> Bool
$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
compare :: Uniqueness -> Uniqueness -> Ordering
$ccompare :: Uniqueness -> Uniqueness -> Ordering
Ord, Int -> Uniqueness -> ShowS
[Uniqueness] -> ShowS
Uniqueness -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Uniqueness] -> ShowS
$cshowList :: [Uniqueness] -> ShowS
show :: Uniqueness -> String
$cshow :: Uniqueness -> String
showsPrec :: Int -> Uniqueness -> ShowS
$cshowsPrec :: Int -> Uniqueness -> ShowS
Show)

instance Semigroup Uniqueness where
  <> :: 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 = 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Name] -> ShowS
$cshowList :: [Name] -> ShowS
show :: Name -> String
$cshow :: Name -> String
showsPrec :: Int -> Name -> ShowS
$cshowsPrec :: Int -> Name -> ShowS
Show, Name -> Name -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Name -> Name -> Bool
$c/= :: Name -> Name -> Bool
== :: Name -> Name -> Bool
$c== :: Name -> Name -> Bool
Eq, Eq 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
min :: Name -> Name -> Name
$cmin :: Name -> Name -> Name
max :: Name -> Name -> Name
$cmax :: Name -> Name -> Name
>= :: Name -> Name -> Bool
$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
compare :: Name -> Name -> Ordering
$ccompare :: Name -> Name -> Ordering
Ord, String -> Name
forall a. (String -> a) -> IsString a
fromString :: String -> Name
$cfromString :: String -> Name
IsString, NonEmpty Name -> Name
Name -> Name -> 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
stimes :: forall b. Integral b => b -> Name -> Name
$cstimes :: forall b. Integral b => b -> Name -> Name
sconcat :: NonEmpty Name -> Name
$csconcat :: NonEmpty Name -> Name
<> :: Name -> Name -> Name
$c<> :: Name -> Name -> Name
Semigroup)

instance Pretty Name where
  pretty :: forall ann. Name -> Doc ann
pretty = forall a ann. Pretty a => a -> Doc ann
pretty 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 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 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 forall a. Eq a => a -> a -> Bool
== Int
line2 ->
          String
first_part forall a. [a] -> [a] -> [a]
++ String
"-" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
col2
      | Bool
otherwise ->
          String
first_part forall a. [a] -> [a] -> [a]
++ String
"-" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
line2 forall a. [a] -> [a] -> [a]
++ String
":" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
col2
      where
        first_part :: String
first_part = String
file forall a. [a] -> [a] -> [a]
++ String
":" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
line1 forall a. [a] -> [a] -> [a]
++ String
":" forall a. [a] -> [a] -> [a]
++ 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 (forall a. Located a => a -> Loc
locOf a
a, 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 forall a. Eq a => a -> a -> Bool
== String
b_file,
        Int
line1 forall a. Eq a => a -> a -> Bool
== Int
line2 ->
          String
first_part forall a. [a] -> [a] -> [a]
++ String
"-" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
col2
      | String
a_file forall a. Eq a => a -> a -> Bool
== String
b_file ->
          String
first_part forall a. [a] -> [a] -> [a]
++ String
"-" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
line2 forall a. [a] -> [a] -> [a]
++ String
":" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
col2
      where
        first_part :: String
first_part = forall a. Show a => a -> String
show Int
line1 forall a. [a] -> [a] -> [a]
++ String
":" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
col1
    (Loc, Loc)
_ -> 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 forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. 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 forall a b. (a -> b) -> a -> b
$ 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 forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. 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 forall a. Eq a => a -> a -> Bool
== Int
i then Text
"-> " else Text
"   ")
        forall a. Semigroup a => a -> a -> a
<> Text
"#"
        forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
showText Int
i
        forall a. Semigroup a => a -> a -> a
<> (if Int
i forall a. Ord a => a -> a -> Bool
> Int
9 then Text
"" else Text
" ")
        forall a. Semigroup a => a -> a -> a
<> 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VName] -> ShowS
$cshowList :: [VName] -> ShowS
show :: VName -> String
$cshow :: VName -> String
showsPrec :: Int -> VName -> ShowS
$cshowsPrec :: Int -> 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 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 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 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
"\"" forall a. Semigroup a => a -> a -> a
<> Text
s forall a. Semigroup a => a -> a -> a
<> Text
"\""