{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Trustworthy #-}

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

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

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

    -- * Special identifiers
    defaultEntryPoint,

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

import Control.Category
import Data.Int (Int16, Int32, Int64, Int8)
import Data.String
import qualified Data.Text as T
import Data.Word (Word16, Word32, Word64, Word8)
import Futhark.Util.Loc
import Futhark.Util.Pretty
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
/= :: Uniqueness -> Uniqueness -> Bool
$c/= :: Uniqueness -> Uniqueness -> Bool
== :: Uniqueness -> Uniqueness -> Bool
$c== :: 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
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
$cp1Ord :: Eq 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
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
(<>) = Uniqueness -> Uniqueness -> Uniqueness
forall a. Ord a => a -> a -> a
min

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

instance Pretty Uniqueness where
  ppr :: Uniqueness -> Doc
ppr Uniqueness
Unique = Doc
star
  ppr Uniqueness
Nonunique = Doc
empty

-- | Whether some operator is commutative or not.  The 'Monoid'
-- instance returns the least commutative of its arguments.
data Commutativity
  = Noncommutative
  | Commutative
  deriving (Commutativity -> Commutativity -> Bool
(Commutativity -> Commutativity -> Bool)
-> (Commutativity -> Commutativity -> Bool) -> Eq Commutativity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Commutativity -> Commutativity -> Bool
$c/= :: Commutativity -> Commutativity -> Bool
== :: Commutativity -> Commutativity -> Bool
$c== :: Commutativity -> Commutativity -> Bool
Eq, Eq Commutativity
Eq Commutativity
-> (Commutativity -> Commutativity -> Ordering)
-> (Commutativity -> Commutativity -> Bool)
-> (Commutativity -> Commutativity -> Bool)
-> (Commutativity -> Commutativity -> Bool)
-> (Commutativity -> Commutativity -> Bool)
-> (Commutativity -> Commutativity -> Commutativity)
-> (Commutativity -> Commutativity -> Commutativity)
-> Ord Commutativity
Commutativity -> Commutativity -> Bool
Commutativity -> Commutativity -> Ordering
Commutativity -> Commutativity -> Commutativity
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 :: Commutativity -> Commutativity -> Commutativity
$cmin :: Commutativity -> Commutativity -> Commutativity
max :: Commutativity -> Commutativity -> Commutativity
$cmax :: Commutativity -> Commutativity -> Commutativity
>= :: Commutativity -> Commutativity -> Bool
$c>= :: Commutativity -> Commutativity -> Bool
> :: Commutativity -> Commutativity -> Bool
$c> :: Commutativity -> Commutativity -> Bool
<= :: Commutativity -> Commutativity -> Bool
$c<= :: Commutativity -> Commutativity -> Bool
< :: Commutativity -> Commutativity -> Bool
$c< :: Commutativity -> Commutativity -> Bool
compare :: Commutativity -> Commutativity -> Ordering
$ccompare :: Commutativity -> Commutativity -> Ordering
$cp1Ord :: Eq Commutativity
Ord, Int -> Commutativity -> ShowS
[Commutativity] -> ShowS
Commutativity -> String
(Int -> Commutativity -> ShowS)
-> (Commutativity -> String)
-> ([Commutativity] -> ShowS)
-> Show Commutativity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Commutativity] -> ShowS
$cshowList :: [Commutativity] -> ShowS
show :: Commutativity -> String
$cshow :: Commutativity -> String
showsPrec :: Int -> Commutativity -> ShowS
$cshowsPrec :: Int -> Commutativity -> ShowS
Show)

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

instance Monoid Commutativity where
  mempty :: Commutativity
mempty = Commutativity
Commutative

-- | The name of the default program entry point (main).
defaultEntryPoint :: Name
defaultEntryPoint :: Name
defaultEntryPoint = String -> Name
nameFromString String
"main"

-- | 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
showList :: [Name] -> ShowS
$cshowList :: [Name] -> ShowS
show :: Name -> String
$cshow :: Name -> String
showsPrec :: Int -> Name -> ShowS
$cshowsPrec :: Int -> Name -> ShowS
Show, Name -> Name -> Bool
(Name -> Name -> Bool) -> (Name -> Name -> Bool) -> Eq Name
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
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
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
$cp1Ord :: Eq Name
Ord, String -> Name
(String -> Name) -> IsString Name
forall a. (String -> a) -> IsString a
fromString :: String -> Name
$cfromString :: String -> Name
IsString, b -> Name -> Name
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
stimes :: 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
  ppr :: Name -> Doc
ppr = String -> Doc
text (String -> Doc) -> (Name -> String) -> Name -> Doc
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 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 :: 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 :: 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

-- | 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 -> [String] -> String
prettyStacktrace :: Int -> [String] -> String
prettyStacktrace Int
cur = [String] -> String
unlines ([String] -> String)
-> ([String] -> [String]) -> [String] -> String
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Int -> ShowS) -> [Int] -> [String] -> [String]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> ShowS
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 -> ShowS
f Int
i String
x =
      (if Int
cur Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
i then String
"-> " else String
"   ")
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ Char
'#' Char -> ShowS
forall a. a -> [a] -> [a]
:
      Int -> String
forall a. Show a => a -> String
show Int
i
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ (if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
9 then String
"" else String
" ")
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" "
        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
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
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 (Name -> String) -> (VName -> Name) -> VName -> String
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 :: String -> String
quote :: ShowS
quote String
s = String
"\"" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\""

-- | As 'quote', but works on prettyprinted representation.
pquote :: Doc -> Doc
pquote :: Doc -> Doc
pquote = Doc -> Doc
dquotes