Pattern_old_grammar.hs

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

  {-  LANGUAGE CPP #-}

#define DO_TRACE 0

#define SHOW_PAT_NODE_ATTRS 0

#define WARN_IGNORED_SUBPATTERNS 1
#define NEVER_IGNORE_SUBPATTERNS 0

-- Formerly DEBUG_WITH_DEEPSEQ_GENERICS.
-- Now also needed to force issuance of all compilePat warnings
-- (so not strictly a debugging flag anymore).
-- [Except it didn't work...]
--- #define NFDATA_INSTANCE_PATTERN 0  -- now a .cabal flag

#define DO_DERIVE_DATA_AND_TYPEABLE 0
#define DO_DERIVE_ONLY_TYPEABLE 1
#if DO_DERIVE_ONLY_TYPEABLE && DO_DERIVE_DATA_AND_TYPEABLE
#undef DO_DERIVE_ONLY_TYPEABLE
#warning DO_DERIVE_ONLY_TYPEABLE forced 0, due to DO_DERIVE_DATA_AND_TYPEABLE being 1.
#define DO_DERIVE_ONLY_TYPEABLE 0
#endif

-- Now specified via --flag=[-]USE_WWW_DEEPSEQ
--- #define USE_WW_DEEPSEQ 1

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

-- Good idea: Let * be followed by an integer N.
-- This shall have the semantics that, when that node
-- is matched in the pattern, instead of rnf it is forcen N'd.

-- There may be fusion possible (which is worth trying here
-- for practise, even if this lib is not used much):
--
--   forcep p1 . forcep p2 = forcep (unionPat [p1,p2])
--
-- This holds if pattern doesn't contain #, or any (type-)constrained
-- subpatterns -- the latter might work out, if exclude # from them too,
-- but I'm not sure.  With #, we lose even monotonicity, let alone
-- the above law.
--
-- For the above to hold, remember, the union must have exactly
-- the "forcing potential" of the LHS -- no more, no less.

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

#if DO_DERIVE_DATA_AND_TYPEABLE
  {-# LANGUAGE DeriveDataTypeable #-}
#endif
-- XXX Only needed for something in Blah.hs.
-- Check into it, and see if can't get rid of the need
-- for Typeable instances in here!
#if DO_DERIVE_ONLY_TYPEABLE
  {-# LANGUAGE DeriveDataTypeable #-}
#endif
#if NFDATA_INSTANCE_PATTERN
  -- For testing only (controlling trace interleaving):
  {-# LANGUAGE DeriveGeneric #-}
#endif
  {-  LANGUAGE DeriveFunctor #-}

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

-- |
-- Module      :  Control.DeepSeq.Bounded.Pattern_old_grammar
-- Copyright   :  Andrew G. Seniuk 2014-2015
-- License     :  BSD-style (see the file LICENSE)
--
-- Maintainer  :  Andrew Seniuk <rasfar@gmail.com>
-- Stability   :  provisional
-- Portability :  portable
--

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

#warning You are using the old pattern grammar (NEW_IMPROVED_PATTERN_GRAMMAR flag is False). This will be deprecated in version 0.7.

  module Control.DeepSeq.Bounded.Pattern_old_grammar
--- {-# DEPRECATED "Use Wobble instead" #-}
  where

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

#if DO_DERIVE_DATA_AND_TYPEABLE
  import Data.Data ( Data )
  import Data.Typeable ( Typeable )
#elif DO_DERIVE_ONLY_TYPEABLE
  import Data.Typeable ( Typeable )
#endif

#if USE_WW_DEEPSEQ
  import Control.DeepSeq ( NFData )
#endif

  import Data.List ( intercalate )
  import Data.Char ( isDigit )
  import Data.Maybe ( isNothing, fromJust )
  import Data.Maybe ( isJust )

  import Debug.Trace ( trace )
#if USE_WW_DEEPSEQ
  -- The only uses of force in this module are for debugging purposes
  -- (including trying to get messages to be displayed in a timely
  -- manner, although that problem has not been completely solved).
  import Control.DeepSeq ( force )
#if NFDATA_INSTANCE_PATTERN
  -- for helping trace debugging
  import qualified Control.DeepSeq.Generics as DSG
  import qualified GHC.Generics as GHC ( Generic )
#endif
#endif

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

#if DO_TRACE
  mytrace = trace
#else
  mytrace _ = id
#endif

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

  data Rose a = Node a [ Rose a ]
#if NFDATA_INSTANCE_PATTERN
#if DO_DERIVE_DATA_AND_TYPEABLE
   deriving (Show, Eq, GHC.Generic, Data, Typeable)
-- deriving (Show, Eq, Functor, GHC.Generic, Data, Typeable)
#elif DO_DERIVE_ONLY_TYPEABLE
   deriving (Show, Eq, GHC.Generic, Typeable)
#else
   deriving (Show, Eq, GHC.Generic)
#endif
#else
#if DO_DERIVE_DATA_AND_TYPEABLE
   deriving (Show, Eq, Data, Typeable)
#elif DO_DERIVE_ONLY_TYPEABLE
   deriving (Show, Eq, Typeable)
#else
   deriving (Show, Eq)
#endif
#endif
  type Pattern = Rose PatNode

  instance Functor Rose where
    fmap f (Node x chs) = Node (f x) (map (fmap f) chs)

#if NFDATA_INSTANCE_PATTERN
  instance NFData a => NFData (Rose a) where rnf = DSG.genericRnf
#endif

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

  -- | Note that only 'WR', 'TR' and 'PR' allow for explicit recursion.
  -- The other 'PatNode's are in leaf position when they occur in a 'Pattern'.

  data PatNode
       =

         WR  -- ^ Continue pattern matching descendants.
       | WS  -- ^ Stop recursing (nothing more forced down this branch).
       | WN Int  -- ^ @'rnfn' n@ the branch under this node.
#if USE_WW_DEEPSEQ
       | WW  -- ^ Fully force ('rnf') the whole branch under this node.
#endif
       | WI  -- ^ Don't even unwrap the constructor of this node.
{--} -- XXX It's still unclear whether TI should allow subpatterns;
-- the alternative is for TI, when type doesn't match, to behave
-- as "." (no subpatterns); but since I say "otherwise behave as TR",
-- and TR says "continue pattern matching descendants", this seems to
-- say that subpatterns should be permitted.  Certainly it's no problem
-- to permit subpatterns in this case, but WI should still ignore
-- subpatterns since it will always be # regardless of node type.
-- (Subpatterns ought to be "safely redundant" in this case, but whether
-- they are depends on implementation and needs to be tested if allow
-- WI subpatterns to survive past the parser/compiler!)
--   And this all applies to TW and TN too, right? Yes.
-- It seems clear that TI, TW and TN should all allow subpatterns.
-- And that WI, WW and WN should elide them and issue a warning.
--   But, none of my present woes seem to be connected with this...
-- Nonetheless, it's important to pin down the semantics.
#if 1
       | TR [String]  -- ^ Match any of the types in the list (and continue pattern matching descendants); behave as 'WI' for nodes of type not in the list. (Note this behaviour is the complement of 'TI' behaviour.)
---    | TS [String]  -- ^ Same as 'TR' except no subpatterns present.
       | TN Int [String]  -- ^ @'rnfn' n@ the branch under this node, if the node type matches any of the types in the list.
#if USE_WW_DEEPSEQ
       | TW [String]  -- ^ Fully force ('rnf') the whole branch under this node, if the node type matches any of the types in the list; otherwise behave as 'WI'.
#endif
       | TI [String]  -- ^ Don't even unwrap the constructor of this node, if it's type is in the list; otherwise behave as 'WR'. (Note this behaviour is the complement of 'TR' behaviour.)
#else
       | TR [TypeRep]  -- ...
#endif
#if PARALLELISM_EXPERIMENT
       | PR  -- ^ Spark the pattern matching of this subtree.
       | PN Int  -- ^ Spark @'rnfn' n@ of this subtree.
#if USE_WW_DEEPSEQ
       | PW  -- ^ Spark the full forcing ('rnf') of this subtree.
#endif
#endif

#if NFDATA_INSTANCE_PATTERN
#if DO_DERIVE_DATA_AND_TYPEABLE
       deriving ( Show, Eq, Typeable, Data, GHC.Generic )
#elif DO_DERIVE_ONLY_TYPEABLE
       deriving ( Show, Eq, Typeable, GHC.Generic )
#else
       deriving ( Show, Eq, GHC.Generic )
#endif
#else
#if DO_DERIVE_DATA_AND_TYPEABLE
       deriving ( Show, Eq, Typeable )  -- Data apparently not needed
#elif DO_DERIVE_ONLY_TYPEABLE
       deriving ( Show, Eq, Typeable )
#else
       deriving ( Show, Eq )
#endif
#endif

#if NFDATA_INSTANCE_PATTERN
  instance NFData PatNode where rnf = DSG.genericRnf
#endif

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

#if 0
  patternShapeOK :: Data a => Pattern -> a -> Bool
  patternShapeOK pat x = S.shapeOf pat == S.shapeOf x
#endif

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

  -- Note that Ord is derived, so the order that the constructors
  -- are listed matters!  (This only affects GHC rules, SFAIK.)
  -- (This data type is here, to avoid cyclical imports which
  -- GHC pretty much is useless with.)
  --------
  -- On the one hand, we want to keep this lightweight -- it can in
  -- principle be a single bit (Insulate/Propagate), as originally planned!
  -- But the Spark thing was too useful; and Print and Error would
  -- also be useful.  But they're more orthogonal.
#if 0
  type Spark = Bool
  type PrintPeriod = Int
  type ErrorMsg = String
  data SeqNode =
           Insulate Spark PrintPeriod
         | Conduct Spark PrintPeriod
         | Force Spark PrintPeriod
         | Error ErrorMsg
    deriving ( Eq, Ord )
#else
  data SeqNode =
           Insulate
---      | Conduct
         | Propagate  -- XXX if include Conduct, then rename Propagate to Force
#if PARALLELISM_EXPERIMENT
         | Spark
#endif
-- These would break the Ord; and besides, they're sort of orthogonal
-- (as is Spark)
---      | Print Int
---      | Error String
    deriving ( Eq, Ord )
#endif

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