------------------------------------------------------------------------------- -- 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 -- 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 -- -- 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 -> () #if PARALLELISM_EXPERIMENT grnf_S Propagate (SOP (Z xs)) = grnf_P xs `seq` () grnf_S {-Spark-}_ (SOP (Z xs)) = grnf_P xs `par` () #else grnf_S {-Propagate-}_ (SOP (Z xs)) = grnf_P xs `seq` () #endif 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 -------------------------------------------------------------------------------