module UHC.Light.Compiler.CHR.Guard
( Guard (..) )
where
import UHC.Util.CHR
import UHC.Light.Compiler.CHR.Key
import UHC.Util.Pretty
import UHC.Light.Compiler.Base.Common
import UHC.Light.Compiler.Ty
import Control.Monad
import UHC.Util.Binary
import UHC.Util.Serialize



{-# LINE 39 "src/ehc/CHR/Guard.chs" #-}
data Guard
  = HasStrictCommonScope    PredScope PredScope PredScope                   -- have strict/proper common scope?
  | IsVisibleInScope        PredScope PredScope                             -- is visible in 2nd scope?
  | NotEqualScope           PredScope PredScope                             -- scopes are unequal
  | EqualScope              PredScope PredScope                             -- scopes are equal
  | IsStrictParentScope     PredScope PredScope PredScope                   -- parent scope of each other?
  | NonEmptyRowLacksLabel   Ty LabelOffset Ty Label                         -- non empty row does not have label?, yielding its position + rest
  deriving (Typeable)

{-# LINE 60 "src/ehc/CHR/Guard.chs" #-}
ppGuard :: Guard -> PP_Doc
ppGuard (HasStrictCommonScope   sc1 sc2 sc3) = ppParensCommas' [sc1 >#< "<" >#< sc2,sc1 >#< "<=" >#< sc3]
ppGuard (IsStrictParentScope    sc1 sc2 sc3) = ppParens (sc1 >#< "==" >#< sc2 >#< "/\\" >#< sc2 >#< "/=" >#< sc3)
ppGuard (IsVisibleInScope       sc1 sc2    ) = sc1 >#< "`visibleIn`" >#< sc2
ppGuard (NotEqualScope          sc1 sc2    ) = sc1 >#< "/=" >#< sc2
ppGuard (EqualScope             sc1 sc2    ) = sc1 >#< "==" >#< sc2
ppGuard (NonEmptyRowLacksLabel  r o t l    ) = ppParens (t >#< "==" >#< ppParens (r >#< "| ...")) >#< "\\" >#< l >|< "@" >|< o

{-# LINE 79 "src/ehc/CHR/Guard.chs" #-}
instance Show Guard where
  show _ = "CHR Guard"

instance PP Guard where
  pp = ppGuard

{-# LINE 91 "src/ehc/CHR/Guard.chs" #-}
instance Serialize Guard where
  sput (HasStrictCommonScope     a b c  ) = sputWord8 0  >> sput a >> sput b >> sput c
  sput (IsVisibleInScope         a b    ) = sputWord8 1  >> sput a >> sput b
  sput (NotEqualScope            a b    ) = sputWord8 2  >> sput a >> sput b
  sput (EqualScope               a b    ) = sputWord8 3  >> sput a >> sput b
  sput (IsStrictParentScope      a b c  ) = sputWord8 4  >> sput a >> sput b >> sput c
  sput (NonEmptyRowLacksLabel    a b c d) = sputWord8 5  >> sput a >> sput b >> sput c >> sput d
  sget = do t <- sgetWord8
            case t of
              0  -> liftM3 HasStrictCommonScope     sget sget sget
              1  -> liftM2 IsVisibleInScope         sget sget
              2  -> liftM2 NotEqualScope            sget sget
              3  -> liftM2 EqualScope               sget sget
              4  -> liftM3 IsStrictParentScope      sget sget sget
              5  -> liftM4 NonEmptyRowLacksLabel    sget sget sget sget