module Futhark.Internalise.TypesValuesTests (tests) where

import Control.Monad.Free (Free (..))
import Data.Map qualified as M
import Data.String (fromString)
import Futhark.IR.Syntax hiding (Free)
import Futhark.IR.SyntaxTests ()
import Futhark.Internalise.TypesValues
import Language.Futhark.SyntaxTests ()
import Test.Tasty
import Test.Tasty.HUnit

internaliseTypeTests :: TestTree
internaliseTypeTests :: TestTree
internaliseTypeTests =
  String -> [TestTree] -> TestTree
testGroup
    String
"internaliseType"
    [ TypeBase Size NoUniqueness
-> [Tree (TypeBase ExtShape Uniqueness)] -> TestTree
mkTest
        TypeBase Size NoUniqueness
"[0]()"
        [[Tree (TypeBase ExtShape Uniqueness)]
-> Tree (TypeBase ExtShape Uniqueness)
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free [TypeBase ExtShape Uniqueness -> Tree (TypeBase ExtShape Uniqueness)
forall (f :: * -> *) a. a -> Free f a
Pure TypeBase ExtShape Uniqueness
"[0i64]unit"]],
      TypeBase Size NoUniqueness
-> [Tree (TypeBase ExtShape Uniqueness)] -> TestTree
mkTest
        TypeBase Size NoUniqueness
"{a: [t_7447][n_7448](f32, f32), b: i64, c: i64}"
        [[Tree (TypeBase ExtShape Uniqueness)]
-> Tree (TypeBase ExtShape Uniqueness)
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free [TypeBase ExtShape Uniqueness -> Tree (TypeBase ExtShape Uniqueness)
forall (f :: * -> *) a. a -> Free f a
Pure TypeBase ExtShape Uniqueness
"[t_7447][n_7448]f32", TypeBase ExtShape Uniqueness -> Tree (TypeBase ExtShape Uniqueness)
forall (f :: * -> *) a. a -> Free f a
Pure TypeBase ExtShape Uniqueness
"[t_7447][n_7448]f32"], TypeBase ExtShape Uniqueness -> Tree (TypeBase ExtShape Uniqueness)
forall (f :: * -> *) a. a -> Free f a
Pure TypeBase ExtShape Uniqueness
"i64", TypeBase ExtShape Uniqueness -> Tree (TypeBase ExtShape Uniqueness)
forall (f :: * -> *) a. a -> Free f a
Pure TypeBase ExtShape Uniqueness
"i64"],
      TypeBase Size NoUniqueness
-> [Tree (TypeBase ExtShape Uniqueness)] -> TestTree
mkTest
        TypeBase Size NoUniqueness
"([0]i32, {a: f32, b: f32, c: f32, d: [0]((f32, f32), (f32, f32))})"
        [ [Tree (TypeBase ExtShape Uniqueness)]
-> Tree (TypeBase ExtShape Uniqueness)
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free [TypeBase ExtShape Uniqueness -> Tree (TypeBase ExtShape Uniqueness)
forall (f :: * -> *) a. a -> Free f a
Pure TypeBase ExtShape Uniqueness
"[0i64]i32"],
          TypeBase ExtShape Uniqueness -> Tree (TypeBase ExtShape Uniqueness)
forall (f :: * -> *) a. a -> Free f a
Pure TypeBase ExtShape Uniqueness
"f32",
          TypeBase ExtShape Uniqueness -> Tree (TypeBase ExtShape Uniqueness)
forall (f :: * -> *) a. a -> Free f a
Pure TypeBase ExtShape Uniqueness
"f32",
          TypeBase ExtShape Uniqueness -> Tree (TypeBase ExtShape Uniqueness)
forall (f :: * -> *) a. a -> Free f a
Pure TypeBase ExtShape Uniqueness
"f32",
          [Tree (TypeBase ExtShape Uniqueness)]
-> Tree (TypeBase ExtShape Uniqueness)
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free [TypeBase ExtShape Uniqueness -> Tree (TypeBase ExtShape Uniqueness)
forall (f :: * -> *) a. a -> Free f a
Pure TypeBase ExtShape Uniqueness
"[0i64]f32", TypeBase ExtShape Uniqueness -> Tree (TypeBase ExtShape Uniqueness)
forall (f :: * -> *) a. a -> Free f a
Pure TypeBase ExtShape Uniqueness
"[0i64]f32", TypeBase ExtShape Uniqueness -> Tree (TypeBase ExtShape Uniqueness)
forall (f :: * -> *) a. a -> Free f a
Pure TypeBase ExtShape Uniqueness
"[0i64]f32", TypeBase ExtShape Uniqueness -> Tree (TypeBase ExtShape Uniqueness)
forall (f :: * -> *) a. a -> Free f a
Pure TypeBase ExtShape Uniqueness
"[0i64]f32"]
        ],
      TypeBase Size NoUniqueness
-> [Tree (TypeBase ExtShape Uniqueness)] -> TestTree
mkTest
        TypeBase Size NoUniqueness
"[0]([1]i32, f32)"
        [[Tree (TypeBase ExtShape Uniqueness)]
-> Tree (TypeBase ExtShape Uniqueness)
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free [[Tree (TypeBase ExtShape Uniqueness)]
-> Tree (TypeBase ExtShape Uniqueness)
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free [TypeBase ExtShape Uniqueness -> Tree (TypeBase ExtShape Uniqueness)
forall (f :: * -> *) a. a -> Free f a
Pure TypeBase ExtShape Uniqueness
"[0i64][1i64]i32"], TypeBase ExtShape Uniqueness -> Tree (TypeBase ExtShape Uniqueness)
forall (f :: * -> *) a. a -> Free f a
Pure TypeBase ExtShape Uniqueness
"[0i64]f32"]]
    ]
  where
    mkTest :: TypeBase Size NoUniqueness
-> [Tree (TypeBase ExtShape Uniqueness)] -> TestTree
mkTest TypeBase Size NoUniqueness
x [Tree (TypeBase ExtShape Uniqueness)]
y =
      String -> Assertion -> TestTree
testCase (TypeBase Size NoUniqueness -> String
forall a. Pretty a => a -> String
prettyString TypeBase Size NoUniqueness
x) (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ TypeBase Size NoUniqueness -> [Tree (TypeBase ExtShape Uniqueness)]
internaliseType TypeBase Size NoUniqueness
x [Tree (TypeBase ExtShape Uniqueness)]
-> [Tree (TypeBase ExtShape Uniqueness)] -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= [Tree (TypeBase ExtShape Uniqueness)]
y

sumTypeTests :: TestTree
sumTypeTests :: TestTree
sumTypeTests =
  String -> [TestTree] -> TestTree
testGroup
    String
"internaliseConstructors"
    [ String -> Assertion -> TestTree
testCase String
"Dedup of primitives" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
        Map Name [Tree (TypeBase ExtShape Uniqueness)]
-> ([Tree (TypeBase ExtShape Uniqueness)], [(Name, [Int])])
internaliseConstructors
          ( [(Name, [Tree (TypeBase ExtShape Uniqueness)])]
-> Map Name [Tree (TypeBase ExtShape Uniqueness)]
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
              [ (Name
"foo", [TypeBase ExtShape Uniqueness -> Tree (TypeBase ExtShape Uniqueness)
forall (f :: * -> *) a. a -> Free f a
Pure TypeBase ExtShape Uniqueness
"i64"]),
                (Name
"bar", [TypeBase ExtShape Uniqueness -> Tree (TypeBase ExtShape Uniqueness)
forall (f :: * -> *) a. a -> Free f a
Pure TypeBase ExtShape Uniqueness
"i64"])
              ]
          )
          ([Tree (TypeBase ExtShape Uniqueness)], [(Name, [Int])])
-> ([Tree (TypeBase ExtShape Uniqueness)], [(Name, [Int])])
-> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= ( [TypeBase ExtShape Uniqueness -> Tree (TypeBase ExtShape Uniqueness)
forall (f :: * -> *) a. a -> Free f a
Pure TypeBase ExtShape Uniqueness
"i64"],
                [ (Name
"bar", [Int
0]),
                  (Name
"foo", [Int
0])
                ]
              ),
      String -> Assertion -> TestTree
testCase String
"Dedup of array" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
        Map Name [Tree (TypeBase ExtShape Uniqueness)]
-> ([Tree (TypeBase ExtShape Uniqueness)], [(Name, [Int])])
internaliseConstructors
          ( [(Name, [Tree (TypeBase ExtShape Uniqueness)])]
-> Map Name [Tree (TypeBase ExtShape Uniqueness)]
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
              [ (Name
"foo", [TypeBase ExtShape Uniqueness -> Tree (TypeBase ExtShape Uniqueness)
forall (f :: * -> *) a. a -> Free f a
Pure TypeBase ExtShape Uniqueness
"[?0]i64"]),
                (Name
"bar", [TypeBase ExtShape Uniqueness -> Tree (TypeBase ExtShape Uniqueness)
forall (f :: * -> *) a. a -> Free f a
Pure TypeBase ExtShape Uniqueness
"[?0]i64"])
              ]
          )
          ([Tree (TypeBase ExtShape Uniqueness)], [(Name, [Int])])
-> ([Tree (TypeBase ExtShape Uniqueness)], [(Name, [Int])])
-> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= ( [TypeBase ExtShape Uniqueness -> Tree (TypeBase ExtShape Uniqueness)
forall (f :: * -> *) a. a -> Free f a
Pure TypeBase ExtShape Uniqueness
"[?0]i64", TypeBase ExtShape Uniqueness -> Tree (TypeBase ExtShape Uniqueness)
forall (f :: * -> *) a. a -> Free f a
Pure TypeBase ExtShape Uniqueness
"[?0]i64"],
                [ (Name
"bar", [Int
0]),
                  (Name
"foo", [Int
1])
                ]
              ),
      String -> Assertion -> TestTree
testCase
        String
"Dedup of array of tuple"
        (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ Map Name [Tree (TypeBase ExtShape Uniqueness)]
-> ([Tree (TypeBase ExtShape Uniqueness)], [(Name, [Int])])
internaliseConstructors
          ( [(Name, [Tree (TypeBase ExtShape Uniqueness)])]
-> Map Name [Tree (TypeBase ExtShape Uniqueness)]
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
              [ (Name
"foo", [[Tree (TypeBase ExtShape Uniqueness)]
-> Tree (TypeBase ExtShape Uniqueness)
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free [TypeBase ExtShape Uniqueness -> Tree (TypeBase ExtShape Uniqueness)
forall (f :: * -> *) a. a -> Free f a
Pure TypeBase ExtShape Uniqueness
"[?0]i64", TypeBase ExtShape Uniqueness -> Tree (TypeBase ExtShape Uniqueness)
forall (f :: * -> *) a. a -> Free f a
Pure TypeBase ExtShape Uniqueness
"[?0]i64"]]),
                (Name
"bar", [TypeBase ExtShape Uniqueness -> Tree (TypeBase ExtShape Uniqueness)
forall (f :: * -> *) a. a -> Free f a
Pure TypeBase ExtShape Uniqueness
"[?0]i64"])
              ]
          )
          ([Tree (TypeBase ExtShape Uniqueness)], [(Name, [Int])])
-> ([Tree (TypeBase ExtShape Uniqueness)], [(Name, [Int])])
-> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= ( [TypeBase ExtShape Uniqueness -> Tree (TypeBase ExtShape Uniqueness)
forall (f :: * -> *) a. a -> Free f a
Pure TypeBase ExtShape Uniqueness
"[?0]i64", [Tree (TypeBase ExtShape Uniqueness)]
-> Tree (TypeBase ExtShape Uniqueness)
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free [TypeBase ExtShape Uniqueness -> Tree (TypeBase ExtShape Uniqueness)
forall (f :: * -> *) a. a -> Free f a
Pure TypeBase ExtShape Uniqueness
"[?0]i64", TypeBase ExtShape Uniqueness -> Tree (TypeBase ExtShape Uniqueness)
forall (f :: * -> *) a. a -> Free f a
Pure TypeBase ExtShape Uniqueness
"[?0]i64"]],
                [ (Name
"bar", [Int
0]),
                  (Name
"foo", [Int
1, Int
2])
                ]
              )
    ]

-- Be aware that some of these tests simply reinforce current
-- behaviour - it may be that we want to restrict aliasing even
-- further in the future; these tests would have to be updated in such
-- cases.
inferAliasesTests :: TestTree
inferAliasesTests :: TestTree
inferAliasesTests =
  String -> [TestTree] -> TestTree
testGroup
    String
"inferAliases"
    [ [Free [] String]
-> [Free [] String]
-> [[(TypeBase ExtShape Uniqueness, RetAls)]]
-> TestTree
mkTest
        [[Free [] String] -> Free [] String
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free [String -> Free [] String
forall (f :: * -> *) a. a -> Free f a
Pure String
"[0i64]i32"]]
        [[Free [] String] -> Free [] String
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free [String -> Free [] String
forall (f :: * -> *) a. a -> Free f a
Pure String
"[?0]i32"]]
        [[(TypeBase ExtShape Uniqueness
"[?0]i32", [Int] -> [Int] -> RetAls
RetAls [Int
0] [Int
0])]],
      [Free [] String]
-> [Free [] String]
-> [[(TypeBase ExtShape Uniqueness, RetAls)]]
-> TestTree
mkTest
        [[Free [] String] -> Free [] String
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free [String -> Free [] String
forall (f :: * -> *) a. a -> Free f a
Pure String
"[0i64]i32", String -> Free [] String
forall (f :: * -> *) a. a -> Free f a
Pure String
"[0i64]i32"]]
        [[Free [] String] -> Free [] String
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free [String -> Free [] String
forall (f :: * -> *) a. a -> Free f a
Pure String
"[0i64]i32", String -> Free [] String
forall (f :: * -> *) a. a -> Free f a
Pure String
"[0i64]i32"]]
        [ [ (TypeBase ExtShape Uniqueness
"[0i64]i32", [Int] -> [Int] -> RetAls
RetAls [Int
0] [Int
0]),
            (TypeBase ExtShape Uniqueness
"[0i64]i32", [Int] -> [Int] -> RetAls
RetAls [Int
1] [Int
1])
          ]
        ],
      -- Basically zip.
      [Free [] String]
-> [Free [] String]
-> [[(TypeBase ExtShape Uniqueness, RetAls)]]
-> TestTree
mkTest
        [[Free [] String] -> Free [] String
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free [String -> Free [] String
forall (f :: * -> *) a. a -> Free f a
Pure String
"[n_0]i32"], [Free [] String] -> Free [] String
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free [String -> Free [] String
forall (f :: * -> *) a. a -> Free f a
Pure String
"[n_0]i32"]]
        [[Free [] String] -> Free [] String
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free [String -> Free [] String
forall (f :: * -> *) a. a -> Free f a
Pure String
"[n_0]i32", String -> Free [] String
forall (f :: * -> *) a. a -> Free f a
Pure String
"[n_0]i32"]]
        [ [ (TypeBase ExtShape Uniqueness
"[n_0]i32", [Int] -> [Int] -> RetAls
RetAls [] [Int
0]),
            (TypeBase ExtShape Uniqueness
"[n_0]i32", [Int] -> [Int] -> RetAls
RetAls [] [Int
1])
          ]
        ],
      [Free [] String]
-> [Free [] String]
-> [[(TypeBase ExtShape Uniqueness, RetAls)]]
-> TestTree
mkTest
        [[Free [] String] -> Free [] String
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free [String -> Free [] String
forall (f :: * -> *) a. a -> Free f a
Pure String
"[0i64]i32"], [Free [] String] -> Free [] String
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free [String -> Free [] String
forall (f :: * -> *) a. a -> Free f a
Pure String
"[0i64]i32", String -> Free [] String
forall (f :: * -> *) a. a -> Free f a
Pure String
"[0i64]i32"]]
        [[Free [] String] -> Free [] String
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free [String -> Free [] String
forall (f :: * -> *) a. a -> Free f a
Pure String
"[?0]i32", String -> Free [] String
forall (f :: * -> *) a. a -> Free f a
Pure String
"[?0]i32"]]
        [ [ (TypeBase ExtShape Uniqueness
"[?0]i32", [Int] -> [Int] -> RetAls
RetAls [Int
1] [Int
0]),
            (TypeBase ExtShape Uniqueness
"[?0]i32", [Int] -> [Int] -> RetAls
RetAls [Int
2] [Int
1])
          ]
        ],
      [Free [] String]
-> [Free [] String]
-> [[(TypeBase ExtShape Uniqueness, RetAls)]]
-> TestTree
mkTest
        [[Free [] String] -> Free [] String
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free [String -> Free [] String
forall (f :: * -> *) a. a -> Free f a
Pure String
"[0i64][1i64]i32", String -> Free [] String
forall (f :: * -> *) a. a -> Free f a
Pure String
"[0i64][1i64]i32"]]
        [[Free [] String] -> Free [] String
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free [String -> Free [] String
forall (f :: * -> *) a. a -> Free f a
Pure String
"[?0]i32", String -> Free [] String
forall (f :: * -> *) a. a -> Free f a
Pure String
"[?0]i32"]]
        [ [ (TypeBase ExtShape Uniqueness
"[?0]i32", [Int] -> [Int] -> RetAls
RetAls [Int
0] [Int
0]),
            (TypeBase ExtShape Uniqueness
"[?0]i32", [Int] -> [Int] -> RetAls
RetAls [Int
1] [Int
1])
          ]
        ],
      -- Basically unzip.
      [Free [] String]
-> [Free [] String]
-> [[(TypeBase ExtShape Uniqueness, RetAls)]]
-> TestTree
mkTest
        [[Free [] String] -> Free [] String
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free [String -> Free [] String
forall (f :: * -> *) a. a -> Free f a
Pure String
"[n_0][n_1]i32", String -> Free [] String
forall (f :: * -> *) a. a -> Free f a
Pure String
"[n_0][n_1]i32"]]
        [[Free [] String] -> Free [] String
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free [String -> Free [] String
forall (f :: * -> *) a. a -> Free f a
Pure String
"[?0]i32"], [Free [] String] -> Free [] String
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free [String -> Free [] String
forall (f :: * -> *) a. a -> Free f a
Pure String
"[?0]i32"]]
        [ [(TypeBase ExtShape Uniqueness
"[?0]i32", [Int] -> [Int] -> RetAls
RetAls [] [Int
0, Int
1])],
          [(TypeBase ExtShape Uniqueness
"[?0]i32", [Int] -> [Int] -> RetAls
RetAls [] [Int
0, Int
1])]
        ],
      [Free [] String]
-> [Free [] String]
-> [[(TypeBase ExtShape Uniqueness, RetAls)]]
-> TestTree
mkTest
        [ [Free [] String] -> Free [] String
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free [String -> Free [] String
forall (f :: * -> *) a. a -> Free f a
Pure String
"*[n_0][n_1]i32"],
          [Free [] String] -> Free [] String
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free [String -> Free [] String
forall (f :: * -> *) a. a -> Free f a
Pure String
"[n_2]i64"],
          [Free [] String] -> Free [] String
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free [String -> Free [] String
forall (f :: * -> *) a. a -> Free f a
Pure String
"[n_3]i64"]
        ]
        [[Free [] String] -> Free [] String
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free [String -> Free [] String
forall (f :: * -> *) a. a -> Free f a
Pure String
"*[n_0][n_1]i32"]]
        [[(TypeBase ExtShape Uniqueness
"*[n_0][n_1]i32", [Int] -> [Int] -> RetAls
RetAls [] [])]],
      [Free [] String]
-> [Free [] String]
-> [[(TypeBase ExtShape Uniqueness, RetAls)]]
-> TestTree
mkTest
        [[Free [] String] -> Free [] String
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free [String -> Free [] String
forall (f :: * -> *) a. a -> Free f a
Pure String
"[n_0]i32", [Free [] String] -> Free [] String
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free [String -> Free [] String
forall (f :: * -> *) a. a -> Free f a
Pure String
"[n_0][n_1]i32"]]]
        [[Free [] String] -> Free [] String
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free [String -> Free [] String
forall (f :: * -> *) a. a -> Free f a
Pure String
"[n_0]i32"]]
        [[(TypeBase ExtShape Uniqueness
"[n_0]i32", [Int] -> [Int] -> RetAls
RetAls [Int
1] [Int
0])]],
      [Free [] String]
-> [Free [] String]
-> [[(TypeBase ExtShape Uniqueness, RetAls)]]
-> TestTree
mkTest
        []
        [ [Free [] String] -> Free [] String
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free [String -> Free [] String
forall (f :: * -> *) a. a -> Free f a
Pure String
"[n_0]i32", [Free [] String] -> Free [] String
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free [String -> Free [] String
forall (f :: * -> *) a. a -> Free f a
Pure String
"[n_0][n_1]i32"]],
          [Free [] String] -> Free [] String
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free [String -> Free [] String
forall (f :: * -> *) a. a -> Free f a
Pure String
"[n_0]i32"]
        ]
        [ [(TypeBase ExtShape Uniqueness
"[n_0]i32", [Int] -> [Int] -> RetAls
RetAls [] [Int
0]), (TypeBase ExtShape Uniqueness
"[n_0][n_1]i32", [Int] -> [Int] -> RetAls
RetAls [] [Int
1])],
          [(TypeBase ExtShape Uniqueness
"[n_0]i32", [Int] -> [Int] -> RetAls
RetAls [] [Int
1, Int
2])]
        ],
      [Free [] String]
-> [Free [] String]
-> [[(TypeBase ExtShape Uniqueness, RetAls)]]
-> TestTree
mkTest
        [[Free [] String] -> Free [] String
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free [String -> Free [] String
forall (f :: * -> *) a. a -> Free f a
Pure String
"[n_0]i32"]]
        [[Free [] String] -> Free [] String
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free [String -> Free [] String
forall (f :: * -> *) a. a -> Free f a
Pure String
"[m_1][m_1]i32"]]
        [ [(TypeBase ExtShape Uniqueness
"[m_1][m_1]i32", [Int] -> [Int] -> RetAls
RetAls [Int
0] [Int
0])]
        ]
    ]
  where
    mkTest :: [Free [] String]
-> [Free [] String]
-> [[(TypeBase ExtShape Uniqueness, RetAls)]]
-> TestTree
mkTest [Free [] String]
all_param_ts [Free [] String]
all_res_ts [[(TypeBase ExtShape Uniqueness, RetAls)]]
expected =
      String -> Assertion -> TestTree
testCase ([Free [] String] -> String
forall a. Show a => a -> String
show [Free [] String]
all_param_ts String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> [Free [] String] -> String
forall a. Show a => a -> String
show [Free [] String]
all_res_ts) (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
        [Tree (TypeBase Shape Uniqueness)]
-> [Tree (TypeBase ExtShape Uniqueness)]
-> [[(TypeBase ExtShape Uniqueness, RetAls)]]
inferAliases
          ((Free [] String -> Tree (TypeBase Shape Uniqueness))
-> [Free [] String] -> [Tree (TypeBase Shape Uniqueness)]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> TypeBase Shape Uniqueness)
-> Free [] String -> Tree (TypeBase Shape Uniqueness)
forall a b. (a -> b) -> Free [] a -> Free [] b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> TypeBase Shape Uniqueness
forall a. IsString a => String -> a
fromString) [Free [] String]
all_param_ts)
          ((Free [] String -> Tree (TypeBase ExtShape Uniqueness))
-> [Free [] String] -> [Tree (TypeBase ExtShape Uniqueness)]
forall a b. (a -> b) -> [a] -> [b]
map ((String -> TypeBase ExtShape Uniqueness)
-> Free [] String -> Tree (TypeBase ExtShape Uniqueness)
forall a b. (a -> b) -> Free [] a -> Free [] b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> TypeBase ExtShape Uniqueness
forall a. IsString a => String -> a
fromString) [Free [] String]
all_res_ts)
          [[(TypeBase ExtShape Uniqueness, RetAls)]]
-> [[(TypeBase ExtShape Uniqueness, RetAls)]] -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= [[(TypeBase ExtShape Uniqueness, RetAls)]]
expected

tests :: TestTree
tests :: TestTree
tests =
  String -> [TestTree] -> TestTree
testGroup
    String
"Futhark.Internalise.TypesValuesTests"
    [ TestTree
internaliseTypeTests,
      TestTree
sumTypeTests,
      TestTree
inferAliasesTests
    ]