-- \* Basic utilities for interpreting tuples as records.
module Language.Futhark.Tuple
  ( areTupleFields,
    tupleFields,
    tupleFieldNames,
    sortFields,
  )
where

import Data.Char (isDigit, ord)
import Data.List (sortOn)
import qualified Data.Map as M
import qualified Data.Text as T
import Language.Futhark.Core (Name, nameFromString, nameToText)

-- | Does this record map correspond to a tuple?
areTupleFields :: M.Map Name a -> Maybe [a]
areTupleFields :: Map Name a -> Maybe [a]
areTupleFields Map Name a
fs =
  let fs' :: [(Name, a)]
fs' = Map Name a -> [(Name, a)]
forall a. Map Name a -> [(Name, a)]
sortFields Map Name a
fs
   in if [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$ (Name -> Name -> Bool) -> [Name] -> [Name] -> [Bool]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
(==) (((Name, a) -> Name) -> [(Name, a)] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (Name, a) -> Name
forall a b. (a, b) -> a
fst [(Name, a)]
fs') [Name]
tupleFieldNames
        then [a] -> Maybe [a]
forall a. a -> Maybe a
Just ([a] -> Maybe [a]) -> [a] -> Maybe [a]
forall a b. (a -> b) -> a -> b
$ ((Name, a) -> a) -> [(Name, a)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (Name, a) -> a
forall a b. (a, b) -> b
snd [(Name, a)]
fs'
        else Maybe [a]
forall a. Maybe a
Nothing

-- | Construct a record map corresponding to a tuple.
tupleFields :: [a] -> M.Map Name a
tupleFields :: [a] -> Map Name a
tupleFields [a]
as = [(Name, a)] -> Map Name a
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Name, a)] -> Map Name a) -> [(Name, a)] -> Map Name a
forall a b. (a -> b) -> a -> b
$ [Name] -> [a] -> [(Name, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Name]
tupleFieldNames [a]
as

-- | Increasing field names for a tuple (starts at 0).
tupleFieldNames :: [Name]
tupleFieldNames :: [Name]
tupleFieldNames = (Int -> Name) -> [Int] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Name
nameFromString (String -> Name) -> (Int -> String) -> Int -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show) [(Int
0 :: Int) ..]

-- | Sort fields by their name; taking care to sort numeric fields by
-- their numeric value.  This ensures that tuples and tuple-like
-- records match.
sortFields :: M.Map Name a -> [(Name, a)]
sortFields :: Map Name a -> [(Name, a)]
sortFields Map Name a
l = ((Either Int Name, (Name, a)) -> (Name, a))
-> [(Either Int Name, (Name, a))] -> [(Name, a)]
forall a b. (a -> b) -> [a] -> [b]
map (Either Int Name, (Name, a)) -> (Name, a)
forall a b. (a, b) -> b
snd ([(Either Int Name, (Name, a))] -> [(Name, a)])
-> [(Either Int Name, (Name, a))] -> [(Name, a)]
forall a b. (a -> b) -> a -> b
$ ((Either Int Name, (Name, a)) -> Either Int Name)
-> [(Either Int Name, (Name, a))] -> [(Either Int Name, (Name, a))]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Either Int Name, (Name, a)) -> Either Int Name
forall a b. (a, b) -> a
fst ([(Either Int Name, (Name, a))] -> [(Either Int Name, (Name, a))])
-> [(Either Int Name, (Name, a))] -> [(Either Int Name, (Name, a))]
forall a b. (a -> b) -> a -> b
$ [Either Int Name] -> [(Name, a)] -> [(Either Int Name, (Name, a))]
forall a b. [a] -> [b] -> [(a, b)]
zip (((Name, a) -> Either Int Name) -> [(Name, a)] -> [Either Int Name]
forall a b. (a -> b) -> [a] -> [b]
map (Name -> Either Int Name
fieldish (Name -> Either Int Name)
-> ((Name, a) -> Name) -> (Name, a) -> Either Int Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name, a) -> Name
forall a b. (a, b) -> a
fst) [(Name, a)]
l') [(Name, a)]
l'
  where
    l' :: [(Name, a)]
l' = Map Name a -> [(Name, a)]
forall k a. Map k a -> [(k, a)]
M.toList Map Name a
l
    onDigit :: Maybe Int -> Char -> Maybe Int
onDigit Maybe Int
Nothing Char
_ = Maybe Int
forall a. Maybe a
Nothing
    onDigit (Just Int
d) Char
c
      | Char -> Bool
isDigit Char
c = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> Int -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Int
d Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
ord Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'0'
      | Bool
otherwise = Maybe Int
forall a. Maybe a
Nothing
    fieldish :: Name -> Either Int Name
fieldish Name
s = Either Int Name
-> (Int -> Either Int Name) -> Maybe Int -> Either Int Name
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Name -> Either Int Name
forall a b. b -> Either a b
Right Name
s) Int -> Either Int Name
forall a b. a -> Either a b
Left (Maybe Int -> Either Int Name) -> Maybe Int -> Either Int Name
forall a b. (a -> b) -> a -> b
$ (Maybe Int -> Char -> Maybe Int) -> Maybe Int -> Text -> Maybe Int
forall a. (a -> Char -> a) -> a -> Text -> a
T.foldl' Maybe Int -> Char -> Maybe Int
onDigit (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0) (Text -> Maybe Int) -> Text -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Name -> Text
nameToText Name
s