Advertisement
gatoatigrado3

OrdDynamic1

May 2nd, 2012
189
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 1.66 KB | None | 0 0
  1. -- Copyright 2012 gatoatigrado (nicholas tung) [ntung at ntung]
  2. -- Licensed under the Apache License, Version 2.0 (the "License"); you may
  3. -- not use this file except in compliance with the License. You may obtain a
  4. -- copy of the License at http://www.apache.org/licenses/LICENSE-2.0 .
  5.  
  6. {-# LANGUAGE FlexibleContexts,
  7. FlexibleInstances,
  8. NamedFieldPuns,
  9. NoMonomorphismRestriction,
  10. RankNTypes,
  11. ScopedTypeVariables #-}
  12.  
  13. module Alt.Data.OrdDynamic1 (OrdDynamic1, get_ord_dyn1, mk_ord_dyn1) where
  14.  
  15. import Prelude hiding (id, (.))
  16. import Control.Arrow
  17. import Control.Applicative
  18. import Control.Category
  19. import Control.Monad
  20. import Control.Monad.Trans.Class
  21.  
  22. import Data.Dynamic
  23. import Data.Typeable
  24.  
  25. data OrdDynamic1 γ = OrdDynamic1
  26. { get_type :: TypeRep,
  27. get_ord_dyn1 :: forall a. Typeable a => Maybe (γ a),
  28. compareme :: OrdDynamic1 γ -> Ordering }
  29.  
  30. mk_ord_dyn1 :: forall α γ. (Ord (γ α), Typeable α) => γ α -> OrdDynamic1 γ
  31. mk_ord_dyn1 x = OrdDynamic1 { get_type = atyp,
  32. get_ord_dyn1 = gcast x, compareme = go }
  33. where go other@(OrdDynamic1 { get_type, get_ord_dyn1 })
  34. | get_type == atyp = go' (get_ord_dyn1 :: Maybe (γ α))
  35. | otherwise = compare atyp get_type
  36. go' Nothing = error "mk_ord internal error -- TypeRep's match but types are in fact not equal!!"
  37. go' (Just y) = compare x y
  38. atyp = typeOf (undefined :: α)
  39.  
  40. instance Eq (OrdDynamic1 γ) where
  41. (OrdDynamic1 { compareme }) == o = compareme o == EQ
  42. instance Ord (OrdDynamic1 γ) where
  43. compare (OrdDynamic1 { compareme }) o = compareme o
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement