GSeqable.hs

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

-- XXX Not only untested, but now unneeded...
-- There is no Seqable class, because every instance would default.
-- (rnf_ is just a polymorphic function now.)
-- The module is left as "Seqable" at least for now.

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

-- XXX UNTESTED. And I just changed it a bunch when moved
-- from Bool to SeqNodeKind, but it's still probably far off...

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

  {-  LANGUAGE CPP #-}

#define USE_TRACE 1

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

#if USE_SOP
  {-# LANGUAGE DataKinds #-}
  {-# LANGUAGE TypeFamilies #-}
  {-# LANGUAGE ConstraintKinds #-}
  {-# LANGUAGE TemplateHaskell #-}
  {-# LANGUAGE GADTs #-}  -- for GHC 7.6.3
#else
  {-# LANGUAGE BangPatterns #-}
  {-# LANGUAGE TypeOperators #-}
  {-# LANGUAGE FlexibleContexts #-}
  {-  LANGUAGE MultiParamTypeClasses #-}
  {-  LANGUAGE Rank2Types #-}
#endif

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

-- |
-- Module      :  Control.DeepSeq.Bounded.Generics.GSeqable
-- Copyright   :  (c) 2014, Andrew G. Seniuk
-- License     :  BSD-style (see the LICENSE file)
--
-- Maintainer  :  Andrew Seniuk <rasfar@gmail.com>
-- Stability   :  provisional
-- Portability :  GHC
--
-- Generic function version of "Seqable" (via "Generics.SOP").
--
-- Probably, a "GHC.Generics" variant would also be possible.
--
-- This metaboilerplate is standard for using the generic deriving
-- facilities of Generics.SOP.  Consider
-- <http://hackage.haskell.org/package/seqaid seqaid>
-- for a turnkey solution.
--
-- > {-# LANGUAGE TemplateHaskell #-}
-- > {-# LANGUAGE DataKinds #-}
-- > {-# LANGUAGE TypeFamilies #-}
-- > {-# LANGUAGE DeriveDataTypeable #-}
-- > 
-- > import Generics.SOP.TH
-- > import Control.DeepSeq.Bounded.Seqable
-- > 
-- > data TA = A1 TB TA | A2
-- > data TB = B1 Int | B2 TA
-- > 
-- > deriveGeneric ''TA
-- > deriveGeneric ''TB
-- > 
-- > main = return $! force_ Propagate (A1 (force_ Propagate (B2 undefined)) A2)

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

  module Control.DeepSeq.Bounded.Generics.GSeqable
#if USE_SOP
  (
      grnf_
    , gseq_
    , gforce_
#else
  (
      genericSeq_
--  , genericSeq_V1
#endif
  ) where

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

  import Control.DeepSeq.Bounded.Pattern ( SeqNodeKind(..) )
--import Control.DeepSeq.Bounded.Seqable ( SeqNodeKind(..) )

#if USE_SOP
  import Generics.SOP
--import Generics.SOP.TH  -- not here, but rather in the module needing to generically derive an Seqable instance
#else
  import GHC.Generics
#endif

  import Control.Parallel ( par )

  import Debug.Trace ( trace )

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

#if USE_SOP

  gseq_ :: Generic a => SeqNodeKind -> a -> b -> b
  gseq_ Insulate     a b  =                 b
  gseq_ k            a b  = grnf_ k a `seq` b  -- sic! both Propagate and Spark

  gforce_ :: Generic a => SeqNodeKind -> a -> a
  gforce_ Insulate     a  =                 a
  gforce_ k            a  = grnf_ k a `seq` a  -- sic! both Propagate and Spark

  grnf_ :: Generic a => SeqNodeKind -> a -> ()
  grnf_ Insulate x = ()
  grnf_ k x = grnf_S k (from x)

  grnf_S :: SeqNodeKind -> SOP I xss -> ()
  grnf_S Propagate  (SOP (Z xs))   = grnf_P xs `seq` ()
  grnf_S {-Spark-}_ (SOP (Z xs))   = grnf_P xs `par` ()
  grnf_S k          (SOP (S xss))  = grnf_S k (SOP xss)

  grnf_P :: NP I xs -> ()
  grnf_P Nil = ()
  grnf_P (I x :* xs)  = x `seq` grnf_P xs

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

#else

#error "GSeqable: must use SOP for now..."

#endif

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