src/Darcs/Sealed.lhs

   1 %  Copyright (C) 2007 David Roundy
   2 %
   3 %  This program is free software; you can redistribute it and/or modify
   4 %  it under the terms of the GNU General Public License as published by
   5 %  the Free Software Foundation; either version 2, or (at your option)
   6 %  any later version.
   7 %
   8 %  This program is distributed in the hope that it will be useful,
   9 %  but WITHOUT ANY WARRANTY; without even the implied warranty of
  10 %  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11 %  GNU General Public License for more details.
  12 %
  13 %  You should have received a copy of the GNU General Public License
  14 %  along with this program; see the file COPYING.  If not, write to
  15 %  the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  16 %  Boston, MA 02110-1301, USA.
  17
  18 \begin{code}
  19 {-# OPTIONS_GHC -cpp -fglasgow-exts #-}
  20 {-# LANGUAGE CPP #-}
  21 -- , MagicHash, GADTs #-}
  22
  23 #include "gadts.h"
  24
  25 module Darcs.Sealed ( Sealed(..), seal, unseal, mapSeal,
  26 #ifndef GADT_WITNESSES
  27                       unsafeUnseal, unsafeUnflippedseal, unsafeUnseal2,
  28 #endif
  29                       Sealed2(..), seal2, unseal2, mapSeal2,
  30                       FlippedSeal(..), flipSeal, unsealFlipped, mapFlipped,
  31                       unsealM, liftSM
  32                     ) where
  33
  34 import GHC.Base ( unsafeCoerce# )
  35 import Darcs.Show
  36
  37 data Sealed a where
  38     Sealed :: a C(x ) -> Sealed a
  39
  40 seal :: a C(x ) -> Sealed a
  41 seal = Sealed
  42
  43 data Sealed2 a where
  44     Sealed2 :: !(a C(x y )) -> Sealed2 a
  45
  46 seal2 :: a C(x y ) -> Sealed2 a
  47 seal2 = Sealed2
  48
  49 data FlippedSeal a C(y) where
  50     FlippedSeal :: !(a C(x y)) -> FlippedSeal a C(y)
  51
  52 flipSeal :: a C(x y) -> FlippedSeal a C(y)
  53 flipSeal = FlippedSeal
  54
  55 #ifndef GADT_WITNESSES
  56 unsafeUnseal :: Sealed a -> a
  57 unsafeUnseal (Sealed a) = a
  58
  59 unsafeUnflippedseal :: FlippedSeal a -> a
  60 unsafeUnflippedseal (FlippedSeal a) = a
  61
  62 unsafeUnseal2 :: Sealed2 a -> a
  63 unsafeUnseal2 (Sealed2 a) = a
  64 #endif
  65
  66 seriouslyUnsafeUnseal :: Sealed a -> a C(())
  67 seriouslyUnsafeUnseal (Sealed a) = unsafeCoerce# a
  68
  69 unseal :: (FORALL(x) a C(x ) -> b) -> Sealed a -> b
  70 unseal f x = f (seriouslyUnsafeUnseal x)
  71
  72 -- laziness property:
  73 -- unseal (const True) undefined == True
  74
  75 unsealM :: Monad m => m (Sealed a) -> (FORALL(x) a C(x) -> m b) -> m b
  76 unsealM m1 m2 = do sx <- m1
  77                    unseal m2 sx
  78
  79 liftSM :: Monad m => (FORALL(x) a C(x) -> b) -> m (Sealed a) -> m b
  80 liftSM f m = do sx <- m
  81                 return (unseal f sx)
  82
  83 mapSeal :: (FORALL(x) a C(x ) -> b C(x )) -> Sealed a -> Sealed b
  84 mapSeal f = unseal (seal . f)
  85
  86 mapFlipped :: (FORALL(x) a C(x y) -> b C(x z)) -> FlippedSeal a C(y) -> FlippedSeal b C(z)
  87 mapFlipped f (FlippedSeal x) = FlippedSeal (f x)
  88
  89 seriouslyUnsafeUnseal2 :: Sealed2 a -> a C(() ())
  90 seriouslyUnsafeUnseal2 (Sealed2 a) = unsafeCoerce# a
  91
  92 unseal2 :: (FORALL(x y) a C(x y ) -> b) -> Sealed2 a -> b
  93 unseal2 f a = f (seriouslyUnsafeUnseal2 a)
  94
  95 mapSeal2 :: (FORALL(x y) a C(x y ) -> b C(x y )) -> Sealed2 a -> Sealed2 b
  96 mapSeal2 f = unseal2 (seal2 . f)
  97
  98 unsealFlipped :: (FORALL(x y) a C(x y) -> b) -> FlippedSeal a C(z) -> b
  99 unsealFlipped f (FlippedSeal a) = f a
 100
 101 instance Show1 a => Show (Sealed a) where
 102     showsPrec d (Sealed x) = showParen (d > app_prec) $ showString "Sealed " . showsPrec1 (app_prec + 1) x
 103 instance Show2 a => Show (Sealed2 a) where
 104     showsPrec d (Sealed2 x) = showParen (d > app_prec) $ showString "Sealed2 " . showsPrec2 (app_prec + 1) x
 105
 106 \end{code}