{-# LANGUAGE LambdaCase, QuasiQuotes, OverloadedStrings #-}
module PrimOpWeakPtrSpec where

import qualified Data.Text as Text
import qualified Data.Map as Map
import qualified Data.Set as Set
import Data.List (sort)
import Data.IORef
import Test.Hspec
import Test.QuickCheck
import System.IO
import Text.Show.Pretty (pPrint, ppShow)
import Text.PrettyPrint.ANSI.Leijen

import Lambda.TH
import Lambda.Analysis.ControlFlowAnalysisM
import Lambda.Pretty (PP(..))

runTests :: IO ()
runTests = hspec spec

spec :: Spec
spec = do
  ----------------------------
  usedRules <- runIO $ newIORef (Set.empty :: Set.Set [Text.Text])

  let filterAndSort keys m = fmap sort $ Map.restrictKeys m (Set.fromList keys)

      sameAs :: Show a => a -> a -> IO ()
      sameAs a b = (PP (ppShow a)) `shouldBe` (PP (ppShow b))

      toMVOp = filterAndSort ["NodeOrigin", "ExternalOrigin", "TagValue", "WeakPtr", "WeakFinalizer"]
      addUsedM a = modifyIORef usedRules (\x -> mappend x . Set.fromList . head . Map.elems . filterAndSort ["Used"] $ a)
      printUsedM = readIORef usedRules >>= pPrint

  ----------------------------

  describe "GHC WeakPtr PrimOps" $ do

    it "mkWeak#" $ do
      cfa <- controlFlowAnalysisM [] ["main"] [prog|
          primop effectful
            "mkWeak#" :: %o.1 -> %b.2 -> (tf.3 : {"State#" {RealWorld} @ t.4} @ t.5 -> {"ghc-prim_GHC.Prim.Unit#" %c.6} @ t.7) -> {"State#" {RealWorld} @ t.8} @ t.9 -> {"ghc-prim_GHC.Prim.Unit#" {"Weak#" %b.12} @ t.10} @ t.11

          main =
            letS
              v01 = [Key]
              v02 = [Value]
              v03 = #T_Token "RealWorld"
              v04 = "mkWeak#" $ v01 v02 fun1 v03
              v06 = case v04 of
                ("ghc-prim_GHC.Prim.Unit#" v05) @ a00 ->
                  v05
            v06
          fun1 p10 =
            letS
              v10 = [Tup0]
              v11 = ["ghc-prim_GHC.Prim.Unit#" v10]
            v11

        |]
      addUsedM cfa
      toMVOp cfa `sameAs` Map.fromList
        [ ( "WeakPtr" , [ [ "v04" , "t.10" , "v02" ] ] )
        , ( "WeakFinalizer" , [ [ "v04" , "fun1" ] ] )
        , ( "ExternalOrigin"
          , [ [ "a00" , "v04" , "t.11" ]
            , [ "v04" , "v04" , "t.11" ]
            , [ "v05" , "v04" , "t.10" ]
            , [ "v06" , "v04" , "t.10" ]
            ]
          )
        , ( "NodeOrigin"
          , [ [ "mkWeak#-finalizer-ignored-result" , "v11" ]
            , [ "p10" , "v03" ]
            , [ "v01" , "v01" ]
            , [ "v02" , "v02" ]
            , [ "v03" , "v03" ]
            , [ "v10" , "v10" ]
            , [ "v11" , "v11" ]
            ]
          )
        , ( "TagValue"
          , [ [ "a00" , "ghc-prim_GHC.Prim.Unit#" ]
            , [ "mkWeak#-finalizer-ignored-result" , "ghc-prim_GHC.Prim.Unit#" ]
            , [ "p10" , "lit:T_Token \"RealWorld\"" ]
            , [ "v01" , "Key" ]
            , [ "v02" , "Value" ]
            , [ "v03" , "lit:T_Token \"RealWorld\"" ]
            , [ "v04" , "ghc-prim_GHC.Prim.Unit#" ]
            , [ "v05" , "Weak#" ]
            , [ "v06" , "Weak#" ]
            , [ "v10" , "Tup0" ]
            , [ "v11" , "ghc-prim_GHC.Prim.Unit#" ]
            ]
          )
        ]

    it "mkWeakNoFinalizer#" $ do
      cfa <- controlFlowAnalysisM [] ["main"] [prog|
          primop effectful
            "mkWeakNoFinalizer#" :: %o.1 -> %b.2 -> {"State#" {RealWorld} @ t.8} @ t.9 -> {"ghc-prim_GHC.Prim.Unit#" {"Weak#" %b.12} @ t.10} @ t.11

          main =
            letS
              v01 = [Key]
              v02 = [Value]
              v03 = #T_Token "RealWorld"
              v04 = "mkWeakNoFinalizer#" $ v01 v02 v03
              v06 = case v04 of
                ("ghc-prim_GHC.Prim.Unit#" v05) @ a00 ->
                  v05
            v06
        |]
      addUsedM cfa
      toMVOp cfa `sameAs` Map.fromList
        [ ( "WeakPtr" , [ [ "v04" , "t.10" , "v02" ] ] )
        , ( "WeakFinalizer" , [ ] )
        , ( "ExternalOrigin"
          , [ [ "a00" , "v04" , "t.11" ]
            , [ "v04" , "v04" , "t.11" ]
            , [ "v05" , "v04" , "t.10" ]
            , [ "v06" , "v04" , "t.10" ]
            ]
          )
        , ( "NodeOrigin"
          , [ [ "v01" , "v01" ]
            , [ "v02" , "v02" ]
            , [ "v03" , "v03" ]
            ]
          )
        , ( "TagValue"
          , [ [ "a00" , "ghc-prim_GHC.Prim.Unit#" ]
            , [ "v01" , "Key" ]
            , [ "v02" , "Value" ]
            , [ "v03" , "lit:T_Token \"RealWorld\"" ]
            , [ "v04" , "ghc-prim_GHC.Prim.Unit#" ]
            , [ "v05" , "Weak#" ]
            , [ "v06" , "Weak#" ]
            ]
          )
        ]

    it "deRefWeak#" $ do
      cfa <- controlFlowAnalysisM [] ["main"] [prog|
          primop effectful
            "mkWeakNoFinalizer#" :: %o.1 -> %b.2 -> {"State#" {RealWorld} @ t.8} @ t.9 -> {"ghc-prim_GHC.Prim.Unit#" {"Weak#" %b.12} @ t.10} @ t.11
            "deRefWeak#"         :: {"Weak#" %a.24} @ t.20 -> {"State#" {RealWorld} @ t.21} @ t.22 -> {"ghc-prim_GHC.Prim.(#,#)" (T_Int64) @ t.23 %a.24} @ t.25

          main =
            letS
              v01 = [Key]
              v02 = [Value]
              v03 = #T_Token "RealWorld"
              v04 = "mkWeakNoFinalizer#" $ v01 v02 v03
              v10 = case v04 of
                ("ghc-prim_GHC.Prim.Unit#" v05) @ a00 ->
                  letS
                    v06 = "deRefWeak#" $ v05 v03
                    v09 = case v06 of
                      ("ghc-prim_GHC.Prim.(#,#)" v07 v08) @ a01 ->
                        v07
                  v09
            v10
        |]
      addUsedM cfa
      toMVOp cfa `sameAs` Map.fromList
        [ ( "WeakPtr" , [ [ "v04" , "t.10" , "v02" ] ] )
        , ( "WeakFinalizer" , [ ] )
        , ( "ExternalOrigin"
          , [ [ "a00" , "v04" , "t.11" ]
            , [ "a01" , "v06" , "t.25" ]
            , [ "v04" , "v04" , "t.11" ]
            , [ "v05" , "v04" , "t.10" ]
            , [ "v06" , "v06" , "t.25" ]
            , [ "v07" , "v06" , "t.23" ]
            , [ "v08" , "v06" , "a.24" ]
            , [ "v09" , "v06" , "t.23" ]
            , [ "v10" , "v06" , "t.23" ]
            ]
          )
        , ( "NodeOrigin"
          , [ [ "v01" , "v01" ]
            , [ "v02" , "v02" ]
            , [ "v03" , "v03" ]
            , [ "v08" , "v02" ]
            ]
          )
        , ( "TagValue"
          , [ [ "a00" , "ghc-prim_GHC.Prim.Unit#" ]
            , [ "a01" , "ghc-prim_GHC.Prim.(#,#)" ]
            , [ "v01" , "Key" ]
            , [ "v02" , "Value" ]
            , [ "v03" , "lit:T_Token \"RealWorld\"" ]
            , [ "v04" , "ghc-prim_GHC.Prim.Unit#" ]
            , [ "v05" , "Weak#" ]
            , [ "v06" , "ghc-prim_GHC.Prim.(#,#)" ]
            , [ "v07" , "lit:T_Int64" ]
            , [ "v08" , "Value" ]
            , [ "v09" , "lit:T_Int64" ]
            , [ "v10" , "lit:T_Int64" ]
            ]
          )
        ]

    it "finalizeWeak#" $ do
      cfa <- controlFlowAnalysisM [] ["main"] [prog|
          primop effectful
            "mkWeak#" :: %o.1 -> %b.2 -> (tf.3 : {"State#" {RealWorld} @ t.4} @ t.5 -> {"ghc-prim_GHC.Prim.Unit#" %c.6} @ t.7) -> {"State#" {RealWorld} @ t.8} @ t.9 -> {"ghc-prim_GHC.Prim.Unit#" {"Weak#" %b.12} @ t.10} @ t.11
            "finalizeWeak#"  :: {"Weak#" %a.20} @ t.21 -> {"State#" {RealWorld} @ t.22} @ t.23 -> {"ghc-prim_GHC.Prim.(#,#)" (T_Int64) @ t.24 (tf.25 : {"State#" {RealWorld} @ t.26} @ t.27 -> {"ghc-prim_GHC.Prim.Unit#" %b} @ t.28)} @ t.29

          main =
            letS
              v01 = [Key]
              v02 = [Value]
              v03 = #T_Token "RealWorld"
              v04 = "mkWeak#" $ v01 v02 fun1 v03
              v010 = case v04 of
                ("ghc-prim_GHC.Prim.Unit#" v05) @ a00 ->
                  letS
                    v06 = "finalizeWeak#" $ v05 v03
                    v09 = case v06 of
                      ("ghc-prim_GHC.Prim.(#,#)" v07 v08) @ a01 ->
                        v07
                  v09
            v010
          fun1 p10 =
            letS
              v10 = [Tup0]
              v11 = ["ghc-prim_GHC.Prim.Unit#" v10]
            v11

        |]
      addUsedM cfa
      toMVOp cfa `sameAs` Map.fromList
        [ ( "WeakPtr" , [ [ "v04" , "t.10" , "v02" ] ] )
        , ( "WeakFinalizer" , [ [ "v04" , "fun1" ] ] )
        , ( "ExternalOrigin"
          , [ [ "a00" , "v04" , "t.11" ]
            , [ "a01" , "v06" , "t.29" ]
            , [ "v010", "v06" , "t.24" ]
            , [ "v04" , "v04" , "t.11" ]
            , [ "v05" , "v04" , "t.10" ]
            , [ "v06" , "v06" , "t.29" ]
            , [ "v07" , "v06" , "t.24" ]
            , [ "v08" , "v06" , "tf.25" ]
            , [ "v09" , "v06" , "t.24" ]
            ]
          )
        , ( "NodeOrigin"
          , [ [ "mkWeak#-finalizer-ignored-result" , "v11" ]
            , [ "p10" , "v03" ]
            , [ "v01" , "v01" ]
            , [ "v02" , "v02" ]
            , [ "v03" , "v03" ]
            , [ "v10" , "v10" ]
            , [ "v11" , "v11" ]
            ]
          )
        , ( "TagValue"
          , [ [ "a00" , "ghc-prim_GHC.Prim.Unit#" ]
            , [ "a01" , "ghc-prim_GHC.Prim.(#,#)" ]
            , [ "mkWeak#-finalizer-ignored-result" , "ghc-prim_GHC.Prim.Unit#" ]
            , [ "p10" , "lit:T_Token \"RealWorld\"" ]
            , [ "v01" , "Key" ]
            , [ "v010", "lit:T_Int64" ]
            , [ "v02" , "Value" ]
            , [ "v03" , "lit:T_Token \"RealWorld\"" ]
            , [ "v04" , "ghc-prim_GHC.Prim.Unit#" ]
            , [ "v05" , "Weak#" ]
            , [ "v06" , "ghc-prim_GHC.Prim.(#,#)" ]
            , [ "v07" , "lit:T_Int64" ]
            , [ "v09" , "lit:T_Int64" ]
            , [ "v10" , "Tup0" ]
            , [ "v11" , "ghc-prim_GHC.Prim.Unit#" ]
            ]
          )
        ]
      filterAndSort ["PNode", "ApplyChain"] cfa `sameAs` Map.fromList
        [ ( "ApplyChain" , [] )
        , ( "PNode",
              [ [ "fun1", "fun1" , "1" , "1" ]
              , [ "v08" , "fun1" , "1" , "1" ]
              ]
          )
        ]

  describe "Coverage" $ do
    it "Used Rules" $ do
      printUsedM
