content: {-# LANGUAGE BangPatterns        #-}
  {-# LANGUAGE OverloadedStrings   #-}
  {-# LANGUAGE ScopedTypeVariables #-}
  
  module Test.ExamplePrograms (tests) where
  
  
  
  import qualified Data.List as L
  
  import Stg.ExamplePrograms
  import Stg.Machine.Types
  
  import qualified Test.Machine.Evaluate.TestTemplates.MachineState    as MST
  import           Test.Machine.Evaluate.TestTemplates.MarshalledValue
  import           Test.Orphans                                        ()
  import           Test.QuickCheck.Modifiers
  import           Test.Tasty
  
  
  
  tests :: TestTree
  tests = testGroup "Example programs"
      [ testGroup "Simple examples"
          [testImplies
          , testAddTwoNumbers
          , testCalculateLength ]
      , testGroup "map"
          [ testMapNot
          , testMapNotForced ]
      , testGroup "Sum using folds"
          [ testSumFoldl'
          , testSumFoldl
          , testSumFoldl'ViaFoldr
          , testSumFoldr ]
      , testGroup "Fibonacci"
          [ testFibonacciNaive
          , testFibonacciImproved
          , testFibonacciZipWith ]
      , testGroup "Concatenation"
          [ testListConcatLeftAssociated
          , testListConcatRightAssociated ]
      , testGroup "Sorting"
          [ testNaiveSort
          , testLibrarySort ]
      ]
  
  
  
  testImplies :: TestTree
  testImplies = marshalledValueTest defSpec
      { testName = "Implication"
      , sourceSpec = \(x,y) -> MarshalSourceSpec
          { resultVar = "main"
          , expectedValue = x <= y
          , source = implies x y }}
  
  testAddTwoNumbers :: TestTree
  testAddTwoNumbers = marshalledValueTest defSpec
      { testName = "Add two numbers"
      , sourceSpec = \(x,y) -> MarshalSourceSpec
          { resultVar = "main"
          , expectedValue = x+y
          , source = addTwoNumbers x y }}
  
  testCalculateLength :: TestTree
  testCalculateLength = marshalledValueTest defSpec
      { testName = "Length of a list"
      , sourceSpec = \(xs :: [Integer]) -> MarshalSourceSpec
          { resultVar = "main"
          , expectedValue = fromIntegral (length xs) :: Integer
          , source = calculateLength xs }}
  
  testMapNot :: TestTree
  testMapNot = MST.machineStateTest MST.defSpec
      { MST.testName = "map not, not forced"
      , MST.successPredicate = \state -> case stgInfo state of
          Info short _long -> short == NoRulesApply
      , MST.source = mapNot [True, False, True]
      , MST.maxSteps = 20}
  
  testMapNotForced :: TestTree
  testMapNotForced = marshalledValueTest defSpec
      { testName = "map not, forced"
      , sourceSpec = \xs -> MarshalSourceSpec
          { resultVar = "main"
          , expectedValue = map not xs
          , source = mapNotForced xs }}
  
  testSumFoldl' :: TestTree
  testSumFoldl' = marshalledValueTest defSpec
      { testName = "Sum via foldl'"
      , sourceSpec = \xs -> MarshalSourceSpec
          { resultVar = "main"
          , expectedValue = sum xs :: Integer
          , source = sum_foldl' xs }}
  
  testSumFoldl :: TestTree
  testSumFoldl = marshalledValueTest defSpec
      { testName = "Sum via foldl"
      , sourceSpec = \xs -> MarshalSourceSpec
          { resultVar = "main"
          , expectedValue = sum xs :: Integer
          , source = sum_foldl xs }}
  
  testSumFoldl'ViaFoldr :: TestTree
  testSumFoldl'ViaFoldr = marshalledValueTest defSpec
      { testName = "Sum via foldl' implemented with foldr"
      , sourceSpec = \xs -> MarshalSourceSpec
          { resultVar = "main"
          , expectedValue = sum xs :: Integer
          , source = sum_foldl'ViaFoldr xs }}
  
  testSumFoldr :: TestTree
  testSumFoldr = marshalledValueTest defSpec
      { testName = "Sum via foldr"
      , sourceSpec = \xs -> MarshalSourceSpec
          { resultVar = "main"
          , expectedValue = sum xs :: Integer
          , source = sum_foldr xs }}
  
  fibo :: Integer -> Integer
  fibo = fibo' 0 1
    where
      fibo' !a !_b n | n <= 0 = a
      fibo'  a   b n = fibo' b (a+b) (n-1)
  
  testFibonacciNaive :: TestTree
  testFibonacciNaive = marshalledValueTest defSpec
      { testName = "Naive Fibonacci"
      , sourceSpec = \(NonNegative n) ->
          let smallerN = mod n 16
          in MarshalSourceSpec
              { resultVar = "main"
              , expectedValue = fibo smallerN
              , source = fibonacciNaive smallerN }}
  
  testFibonacciImproved :: TestTree
  testFibonacciImproved = marshalledValueTest defSpec
      { testName = "Improved linear Fibonacci"
      , sourceSpec = \(NonNegative n) -> MarshalSourceSpec
          { resultVar = "main"
          , expectedValue = fibo n
          , source = fibonacciImproved n }}
  
  testFibonacciZipWith :: TestTree
  testFibonacciZipWith = MST.machineStateTest MST.defSpec
      { MST.testName = "Fibonacci via zipWith"
      , MST.successPredicate = \state -> case stgCode state of
          ReturnCon "Int#" [PrimInt n] -> n == fibo 10
          _otherwise  -> False
      , MST.source = fibonacciZipWith }
  
  testListConcatLeftAssociated :: TestTree
  testListConcatLeftAssociated = marshalledValueTest defSpec
      { testName = "List concatenation, left-associated"
      , sourceSpec = \xss -> MarshalSourceSpec
          { resultVar = "main"
          , expectedValue = concat xss :: [Integer]
          , source = listConcatLeftAssociated xss }}
  
  testListConcatRightAssociated :: TestTree
  testListConcatRightAssociated = marshalledValueTest defSpec
      { testName = "List concatenation, right-associated"
      , sourceSpec = \xss -> MarshalSourceSpec
          { resultVar = "main"
          , expectedValue = concat xss :: [Integer]
          , source = listConcatRightAssociated xss }}
  
  testNaiveSort :: TestTree
  testNaiveSort = marshalledValueTest defSpec
      { testName = "Sort using naive Quicksort-inspired algorithm"
      , sourceSpec = \xs -> MarshalSourceSpec
          { resultVar = "main"
          , expectedValue = L.sort xs :: [Integer]
          , source = naiveSort xs }}
  
  testLibrarySort :: TestTree
  testLibrarySort = marshalledValueTest defSpec
      { testName = "Sort using the standard Haskell list sort"
      , sourceSpec = \xs -> MarshalSourceSpec
          { resultVar = "main"
          , expectedValue = L.sort xs :: [Integer]
          , source = librarySort xs }}
  