Remove cabal init comments from .cabal file
[darcs-mirror-sem_syn.git] / BUtil.hs
1 {-# OPTIONS -XRank2Types -XCPP #-}
2 module BUtil where
3
4 import qualified Data.IntMap as IntMap 
5 import Control.Monad 
6
7 import System.IO.Unsafe
8
9 #if __GLASGOW_HASKELL__ >= 610 
10 import Control.OldException
11 #else
12 import Control.Exception
13 #endif
14
15 data Nat = S Nat | Z deriving (Show,Eq)
16
17 toNat x = if x == 0 then 
18               Z
19           else 
20               S (toNat $ x-1)
21
22 fromNat Z     = 0
23 fromNat (S x) = 1 + fromNat x
24
25 fromDistinctList = IntMap.fromList 
26
27 gen_put_bias :: Bias 
28                 -> (forall a. [a] -> [a]) 
29                 -> (Nat -> Nat -> Maybe Nat) 
30                 -> [a] -> [a] 
31                 -> Maybe [Maybe a]
32 gen_put_bias bias get sput s v =
33     do { let ls = length s  
34        ; let g = fromDistinctList (zip (bias ls) s)
35        ; l' <- maybe (fail "...")
36                      return
37                      (sput (toNat ls) (toNat (length v)))
38        ; let t = bias (fromNat l')
39        ; let h = fromDistinctList (zip (get t) v)
40        ; let h'= IntMap.union h g 
41        ; return (map (flip IntMap.lookup h') t) }
42
43 withDefaultBias put bias d s v =
44     do { s' <- put bias s v 
45        ; return (map (maybe d id) s') }
46
47 withDefault put d s v =
48     do { s' <- put s v 
49        ; return (map (maybe d id) s') }
50
51 gen_put_dbias :: Bias -> (forall a. [a] -> [a]) 
52                  -> (Nat -> Nat -> Maybe Nat)
53                  -> a -> [a] -> [a] -> Maybe [a]
54 gen_put_dbias bias get sput d s v =
55     do { s' <- gen_put_bias bias get sput s v
56        ; return (map (maybe d id) s') }
57
58 castError :: a -> Maybe a 
59 castError f = unsafePerformIO $ 
60     do { r <- try (evaluate f)
61        ; case r of
62            Left  e -> return $ Nothing 
63            Right r -> return $ Just $ r }
64
65 type Bias = Int -> [ Int ]
66 rear l    = [ 0 .. l - 1 ]
67 front l   = reverse [ 0 .. l - 1 ]
68 middle l  = [1,3..l] + (reverse [2,4..l])
69 borders l = (reverse [1,3..l])+[2,4..l]