{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Trustworthy #-}
module Language.Futhark.Core
( Uniqueness (..),
SrcLoc,
Loc,
Located (..),
srclocOf,
locStr,
locStrRel,
prettyStacktrace,
Name,
nameToString,
nameFromString,
nameToText,
nameFromText,
VName (..),
baseTag,
baseName,
baseString,
quote,
pquote,
Int8,
Int16,
Int32,
Int64,
Word8,
Word16,
Word32,
Word64,
Half,
)
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 Numeric.Half
import Prelude hiding (id, (.))
data Uniqueness
=
Nonunique
|
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 -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Uniqueness] -> ShowS
$cshowList :: [Uniqueness] -> ShowS
show :: Uniqueness -> [Char]
$cshow :: Uniqueness -> [Char]
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
ppr :: Uniqueness -> Doc
ppr Uniqueness
Unique = Doc
star
ppr Uniqueness
Nonunique = Doc
empty
newtype Name = Name T.Text
deriving (Int -> Name -> ShowS
[Name] -> ShowS
Name -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Name] -> ShowS
$cshowList :: [Name] -> ShowS
show :: Name -> [Char]
$cshow :: Name -> [Char]
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, [Char] -> Name
forall a. ([Char] -> a) -> IsString a
fromString :: [Char] -> Name
$cfromString :: [Char] -> 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
ppr :: Name -> Doc
ppr = [Char] -> Doc
text forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Name -> [Char]
nameToString
nameToString :: Name -> String
nameToString :: Name -> [Char]
nameToString (Name Text
t) = Text -> [Char]
T.unpack Text
t
nameFromString :: String -> Name
nameFromString :: [Char] -> 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
. [Char] -> Text
T.pack
nameToText :: Name -> T.Text
nameToText :: Name -> Text
nameToText (Name Text
t) = Text
t
nameFromText :: T.Text -> Name
nameFromText :: Text -> Name
nameFromText = Text -> Name
Name
locStr :: Located a => a -> String
locStr :: forall a. Located a => a -> [Char]
locStr a
a =
case forall a. Located a => a -> Loc
locOf a
a of
Loc
NoLoc -> [Char]
"unknown location"
Loc (Pos [Char]
file Int
line1 Int
col1 Int
_) (Pos [Char]
_ Int
line2 Int
col2 Int
_)
| Int
line1 forall a. Eq a => a -> a -> Bool
== Int
line2 ->
[Char]
first_part forall a. [a] -> [a] -> [a]
++ [Char]
"-" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
col2
| Bool
otherwise ->
[Char]
first_part forall a. [a] -> [a] -> [a]
++ [Char]
"-" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
line2 forall a. [a] -> [a] -> [a]
++ [Char]
":" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
col2
where
first_part :: [Char]
first_part = [Char]
file forall a. [a] -> [a] -> [a]
++ [Char]
":" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
line1 forall a. [a] -> [a] -> [a]
++ [Char]
":" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
col1
locStrRel :: (Located a, Located b) => a -> b -> String
locStrRel :: forall a b. (Located a, Located b) => a -> b -> [Char]
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 [Char]
a_file Int
_ Int
_ Int
_) Pos
_, Loc (Pos [Char]
b_file Int
line1 Int
col1 Int
_) (Pos [Char]
_ Int
line2 Int
col2 Int
_))
| [Char]
a_file forall a. Eq a => a -> a -> Bool
== [Char]
b_file,
Int
line1 forall a. Eq a => a -> a -> Bool
== Int
line2 ->
[Char]
first_part forall a. [a] -> [a] -> [a]
++ [Char]
"-" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
col2
| [Char]
a_file forall a. Eq a => a -> a -> Bool
== [Char]
b_file ->
[Char]
first_part forall a. [a] -> [a] -> [a]
++ [Char]
"-" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
line2 forall a. [a] -> [a] -> [a]
++ [Char]
":" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
col2
where
first_part :: [Char]
first_part = forall a. Show a => a -> [Char]
show Int
line1 forall a. [a] -> [a] -> [a]
++ [Char]
":" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int
col1
(Loc, Loc)
_ -> forall a. Located a => a -> [Char]
locStr b
b
prettyStacktrace :: Int -> [String] -> String
prettyStacktrace :: Int -> [[Char]] -> [Char]
prettyStacktrace Int
cur = [[Char]] -> [Char]
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 -> ShowS
f [(Int
0 :: Int) ..]
where
f :: Int -> ShowS
f Int
i [Char]
x =
(if Int
cur forall a. Eq a => a -> a -> Bool
== Int
i then [Char]
"-> " else [Char]
" ")
forall a. [a] -> [a] -> [a]
++ Char
'#'
forall a. a -> [a] -> [a]
: forall a. Show a => a -> [Char]
show Int
i
forall a. [a] -> [a] -> [a]
++ (if Int
i forall a. Ord a => a -> a -> Bool
> Int
9 then [Char]
"" else [Char]
" ")
forall a. [a] -> [a] -> [a]
++ [Char]
" "
forall a. [a] -> [a] -> [a]
++ [Char]
x
data VName = VName !Name !Int
deriving (Int -> VName -> ShowS
[VName] -> ShowS
VName -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [VName] -> ShowS
$cshowList :: [VName] -> ShowS
show :: VName -> [Char]
$cshow :: VName -> [Char]
showsPrec :: Int -> VName -> ShowS
$cshowsPrec :: Int -> VName -> ShowS
Show)
baseTag :: VName -> Int
baseTag :: VName -> Int
baseTag (VName Name
_ Int
tag) = Int
tag
baseName :: VName -> Name
baseName :: VName -> Name
baseName (VName Name
vn Int
_) = Name
vn
baseString :: VName -> String
baseString :: VName -> [Char]
baseString = Name -> [Char]
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
quote :: String -> String
quote :: ShowS
quote [Char]
s = [Char]
"\"" forall a. [a] -> [a] -> [a]
++ [Char]
s forall a. [a] -> [a] -> [a]
++ [Char]
"\""
pquote :: Doc -> Doc
pquote :: Doc -> Doc
pquote = Doc -> Doc
dquotes