{-# LANGUAGE DeriveGeneric #-}
{-# 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 GHC.Generics
import Language.SexpGrammar as Sexp
import Language.SexpGrammar.Generic
import Text.Read
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, (forall x. Uniqueness -> Rep Uniqueness x)
-> (forall x. Rep Uniqueness x -> Uniqueness) -> Generic Uniqueness
forall x. Rep Uniqueness x -> Uniqueness
forall x. Uniqueness -> Rep Uniqueness x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Uniqueness x -> Uniqueness
$cfrom :: forall x. Uniqueness -> Rep Uniqueness x
Generic)

instance SexpIso Uniqueness where
  sexpIso :: Grammar Position (Sexp :- t) (Uniqueness :- t)
sexpIso =
    Coproduct Position (Sexp :- t) '[t, t] Uniqueness t
-> Grammar Position (Sexp :- t) (Uniqueness :- t)
forall a (bs :: [*]) t p s.
(Generic a, MkPrismList (Rep a), Match (Rep a) bs t,
 bs ~ Coll (Rep a) t) =>
Coproduct p s bs a t -> Grammar p s (a :- t)
match (Coproduct Position (Sexp :- t) '[t, t] Uniqueness t
 -> Grammar Position (Sexp :- t) (Uniqueness :- t))
-> Coproduct Position (Sexp :- t) '[t, t] Uniqueness t
-> Grammar Position (Sexp :- t) (Uniqueness :- t)
forall a b. (a -> b) -> a -> b
$
      (Grammar Position t (Uniqueness :- t)
 -> Grammar Position (Sexp :- t) (Uniqueness :- t))
-> Coproduct Position (Sexp :- t) '[t] Uniqueness t
-> Coproduct Position (Sexp :- t) '[t, t] Uniqueness t
forall p b a t s (bs1 :: [*]).
(Grammar p b (a :- t) -> Grammar p s (a :- t))
-> Coproduct p s bs1 a t -> Coproduct p s (b : bs1) a t
With (Grammar Position t (Uniqueness :- t)
-> Grammar Position (Sexp :- t) t
-> Grammar Position (Sexp :- t) (Uniqueness :- t)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> Grammar Position (Sexp :- t) t
forall t. Text -> Grammar Position (Sexp :- t) t
Sexp.sym Text
"nonunique") (Coproduct Position (Sexp :- t) '[t] Uniqueness t
 -> Coproduct Position (Sexp :- t) '[t, t] Uniqueness t)
-> Coproduct Position (Sexp :- t) '[t] Uniqueness t
-> Coproduct Position (Sexp :- t) '[t, t] Uniqueness t
forall a b. (a -> b) -> a -> b
$
        (Grammar Position t (Uniqueness :- t)
 -> Grammar Position (Sexp :- t) (Uniqueness :- t))
-> Coproduct Position (Sexp :- t) '[] Uniqueness t
-> Coproduct Position (Sexp :- t) '[t] Uniqueness t
forall p b a t s (bs1 :: [*]).
(Grammar p b (a :- t) -> Grammar p s (a :- t))
-> Coproduct p s bs1 a t -> Coproduct p s (b : bs1) a t
With
          (Grammar Position t (Uniqueness :- t)
-> Grammar Position (Sexp :- t) t
-> Grammar Position (Sexp :- t) (Uniqueness :- t)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> Grammar Position (Sexp :- t) t
forall t. Text -> Grammar Position (Sexp :- t) t
Sexp.sym Text
"unique")
          Coproduct Position (Sexp :- t) '[] Uniqueness t
forall p s a t. Coproduct p s '[] a t
End

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, (forall x. Commutativity -> Rep Commutativity x)
-> (forall x. Rep Commutativity x -> Commutativity)
-> Generic Commutativity
forall x. Rep Commutativity x -> Commutativity
forall x. Commutativity -> Rep Commutativity x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Commutativity x -> Commutativity
$cfrom :: forall x. Commutativity -> Rep Commutativity x
Generic)

instance SexpIso Commutativity where
  sexpIso :: Grammar Position (Sexp :- t) (Commutativity :- t)
sexpIso =
    Coproduct Position (Sexp :- t) '[t, t] Commutativity t
-> Grammar Position (Sexp :- t) (Commutativity :- t)
forall a (bs :: [*]) t p s.
(Generic a, MkPrismList (Rep a), Match (Rep a) bs t,
 bs ~ Coll (Rep a) t) =>
Coproduct p s bs a t -> Grammar p s (a :- t)
match (Coproduct Position (Sexp :- t) '[t, t] Commutativity t
 -> Grammar Position (Sexp :- t) (Commutativity :- t))
-> Coproduct Position (Sexp :- t) '[t, t] Commutativity t
-> Grammar Position (Sexp :- t) (Commutativity :- t)
forall a b. (a -> b) -> a -> b
$
      (Grammar Position t (Commutativity :- t)
 -> Grammar Position (Sexp :- t) (Commutativity :- t))
-> Coproduct Position (Sexp :- t) '[t] Commutativity t
-> Coproduct Position (Sexp :- t) '[t, t] Commutativity t
forall p b a t s (bs1 :: [*]).
(Grammar p b (a :- t) -> Grammar p s (a :- t))
-> Coproduct p s bs1 a t -> Coproduct p s (b : bs1) a t
With (Grammar Position t (Commutativity :- t)
-> Grammar Position (Sexp :- t) t
-> Grammar Position (Sexp :- t) (Commutativity :- t)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> Grammar Position (Sexp :- t) t
forall t. Text -> Grammar Position (Sexp :- t) t
Sexp.sym Text
"noncommutative") (Coproduct Position (Sexp :- t) '[t] Commutativity t
 -> Coproduct Position (Sexp :- t) '[t, t] Commutativity t)
-> Coproduct Position (Sexp :- t) '[t] Commutativity t
-> Coproduct Position (Sexp :- t) '[t, t] Commutativity t
forall a b. (a -> b) -> a -> b
$
        (Grammar Position t (Commutativity :- t)
 -> Grammar Position (Sexp :- t) (Commutativity :- t))
-> Coproduct Position (Sexp :- t) '[] Commutativity t
-> Coproduct Position (Sexp :- t) '[t] Commutativity t
forall p b a t s (bs1 :: [*]).
(Grammar p b (a :- t) -> Grammar p s (a :- t))
-> Coproduct p s bs1 a t -> Coproduct p s (b : bs1) a t
With
          (Grammar Position t (Commutativity :- t)
-> Grammar Position (Sexp :- t) t
-> Grammar Position (Sexp :- t) (Commutativity :- t)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> Grammar Position (Sexp :- t) t
forall t. Text -> Grammar Position (Sexp :- t) t
Sexp.sym Text
"commutative")
          Coproduct Position (Sexp :- t) '[] Commutativity t
forall p s a t. Coproduct p s '[] a t
End

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, (forall x. Name -> Rep Name x)
-> (forall x. Rep Name x -> Name) -> Generic Name
forall x. Rep Name x -> Name
forall x. Name -> Rep Name x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Name x -> Name
$cfrom :: forall x. Name -> Rep Name x
Generic)

instance SexpIso Name where
  sexpIso :: Grammar Position (Sexp :- t) (Name :- t)
sexpIso = (Grammar Position (Text :- t) (Name :- t)
 -> Grammar Position (Sexp :- t) (Name :- t))
-> Grammar Position (Sexp :- t) (Name :- t)
forall a b s t (c :: Meta) (d :: Meta) (f :: * -> *) p.
(Generic a, MkPrismList (Rep a), MkStackPrism f,
 Rep a ~ M1 D d (M1 C c f), StackPrismLhs f t ~ b, Constructor c) =>
(Grammar p b (a :- t) -> Grammar p s (a :- t))
-> Grammar p s (a :- t)
with (Grammar Position (Text :- t) (Name :- t)
-> Grammar Position (Sexp :- t) (Text :- t)
-> Grammar Position (Sexp :- t) (Name :- t)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Grammar Position (Sexp :- t) (Text :- t)
forall t. Grammar Position (Sexp :- t) (Text :- t)
symbol)

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, (forall x. VName -> Rep VName x)
-> (forall x. Rep VName x -> VName) -> Generic VName
forall x. Rep VName x -> VName
forall x. VName -> Rep VName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep VName x -> VName
$cfrom :: forall x. VName -> Rep VName x
Generic)

instance SexpIso VName where
  sexpIso :: Grammar Position (Sexp :- t) (VName :- t)
sexpIso = (Grammar Position (Int :- (Name :- t)) (VName :- t)
 -> Grammar Position (Sexp :- t) (VName :- t))
-> Grammar Position (Sexp :- t) (VName :- t)
forall a b s t (c :: Meta) (d :: Meta) (f :: * -> *) p.
(Generic a, MkPrismList (Rep a), MkStackPrism f,
 Rep a ~ M1 D d (M1 C c f), StackPrismLhs f t ~ b, Constructor c) =>
(Grammar p b (a :- t) -> Grammar p s (a :- t))
-> Grammar p s (a :- t)
with ((Grammar Position (Int :- (Name :- t)) (VName :- t)
  -> Grammar Position (Sexp :- t) (VName :- t))
 -> Grammar Position (Sexp :- t) (VName :- t))
-> (Grammar Position (Int :- (Name :- t)) (VName :- t)
    -> Grammar Position (Sexp :- t) (VName :- t))
-> Grammar Position (Sexp :- t) (VName :- t)
forall a b. (a -> b) -> a -> b
$ \Grammar Position (Int :- (Name :- t)) (VName :- t)
vname ->
    Grammar Position (Sexp :- t) (Text :- t)
forall t. Grammar Position (Sexp :- t) (Text :- t)
Sexp.symbol
      Grammar Position (Sexp :- t) (Text :- t)
-> Grammar Position (Text :- t) (VName :- t)
-> Grammar Position (Sexp :- t) (VName :- t)
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Grammar Position (Int :- (Name :- t)) (Text :- t)
-> Grammar Position (Text :- t) (Int :- (Name :- t))
forall p a b. Grammar p a b -> Grammar p b a
flipped
        ( Grammar Position (Int :- (Name :- t)) ((Name, Int) :- t)
forall p b a t. Grammar p (b :- (a :- t)) ((a, b) :- t)
pair
            Grammar Position (Int :- (Name :- t)) ((Name, Int) :- t)
-> Grammar Position ((Name, Int) :- t) (Text :- t)
-> Grammar Position (Int :- (Name :- t)) (Text :- t)
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ((Name, Int) -> Text)
-> (Text -> Either Mismatch (Name, Int))
-> Grammar Position ((Name, Int) :- t) (Text :- t)
forall a b p t.
(a -> b) -> (b -> Either Mismatch a) -> Grammar p (a :- t) (b :- t)
partialIso
              (\(Name
nm, Int
i) -> String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Name -> String
nameToString Name
nm 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
i)
              ( \Text
s ->
                  let (Text
nm, Text
i) = Text -> Text -> (Text, Text)
T.breakOnEnd Text
"_" Text
s
                   in case String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe Int) -> String -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
i of
                        Just Int
i' -> (Name, Int) -> Either Mismatch (Name, Int)
forall a b. b -> Either a b
Right (String -> Name
nameFromString (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text -> Text
T.init Text
nm, Int
i')
                        Maybe Int
Nothing -> Mismatch -> Either Mismatch (Name, Int)
forall a b. a -> Either a b
Left (Mismatch -> Either Mismatch (Name, Int))
-> Mismatch -> Either Mismatch (Name, Int)
forall a b. (a -> b) -> a -> b
$ Text -> Mismatch
expected Text
"Couldn't parse int of vname"
              )
        )
      Grammar Position (Text :- t) (Int :- (Name :- t))
-> Grammar Position (Int :- (Name :- t)) (VName :- t)
-> Grammar Position (Text :- t) (VName :- t)
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Grammar Position (Int :- (Name :- t)) (VName :- t)
vname

-- | 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