| Line No. | Rev | Author | Line |
|---|---|---|---|
| 1 | 1 | paulosilva | |
| 2 | {-# OPTIONS_GHC -Wall #-} | ||
| 3 | |||
| 4 | ------------------------------------------------------------------------------- | ||
| 5 | |||
| 6 | {- | | ||
| 7 | Module : Language.Type.Utils | ||
| 8 | Description : Useful functions for dealing with type representation. | ||
| 9 | Copyright : (c) Paulo Silva | ||
| 10 | License : LGPL | ||
| 11 | |||
| 12 | Maintainer : paufil@di.uminho.pt | ||
| 13 | Stability : experimental | ||
| 14 | Portability : portable | ||
| 15 | |||
| 16 | -} | ||
| 17 | |||
| 18 | ------------------------------------------------------------------------------- | ||
| 19 | |||
| 20 | module Language.Type.Utils ( | ||
| 21 | isBasicType, | ||
| 22 | isBasicTypeTB, | ||
| 23 | isTVar, | ||
| 24 | isTVarTB, | ||
| 25 | occursIn, | ||
| 26 | occursInTB, | ||
| 27 | isConstructor, | ||
| 28 | collectTVar, | ||
| 29 | collectTVarTB, | ||
| 30 | getTVarNameTB | ||
| 31 | ) where | ||
| 32 | |||
| 33 | import Data.Existential | ||
| 34 | import Language.Type.Syntax | ||
| 35 | |||
| 36 | ------------------------------------------------------------------------------- | ||
| 37 | |||
| 38 | isBasicType :: Type a -> Bool | ||
| 39 | isBasicType One = True | ||
| 40 | isBasicType Bool = True | ||
| 41 | isBasicType Char = True | ||
| 42 | isBasicType String = True | ||
| 43 | isBasicType Int = True | ||
| 44 | isBasicType Float = True | ||
| 45 | isBasicType _ = False | ||
| 46 | |||
| 47 | ------------------------------------------------------------------------------- | ||
| 48 | |||
| 49 | isBasicTypeTB :: TypeBox -> Bool | ||
| 50 | isBasicTypeTB (Hide t) = isBasicType t | ||
| 51 | |||
| 52 | ------------------------------------------------------------------------------- | ||
| 53 | |||
| 54 | isTVar :: Type a -> Bool | ||
| 55 | isTVar (TVar _) = True | ||
| 56 | isTVar _ = False | ||
| 57 | |||
| 58 | ------------------------------------------------------------------------------- | ||
| 59 | |||
| 60 | isTVarTB :: TypeBox -> Bool | ||
| 61 | isTVarTB (Hide t) = isTVar t | ||
| 62 | |||
| 63 | ------------------------------------------------------------------------------- | ||
| 64 | |||
| 65 | occursIn :: Type a -> Type b -> Bool | ||
| 66 | occursIn t (Prod a b) = occursIn t a || occursIn t b | ||
| 67 | occursIn t (Either a b) = occursIn t a || occursIn t b | ||
| 68 | occursIn t (Maybe a) = occursIn t a | ||
| 69 | occursIn t (List a) = occursIn t a | ||
| 70 | occursIn t (Set a) = occursIn t a | ||
| 71 | occursIn t (Map a b) = occursIn t a || occursIn t b | ||
| 72 | occursIn t (Fun a b) = occursIn t a || occursIn t b | ||
| 73 | occursIn t (Rel a b) = occursIn t a || occursIn t b | ||
| 74 | occursIn t (Ord a) = occursIn t a | ||
| 75 | occursIn t (GC a b) = occursIn t a || occursIn t b | ||
| 76 | occursIn (TVar n) (TVar m) = n == m | ||
| 77 | occursIn _ _ = False | ||
| 78 | |||
| 79 | ------------------------------------------------------------------------------- | ||
| 80 | |||
| 81 | occursInTB :: TypeBox -> TypeBox -> Bool | ||
| 82 | occursInTB (Hide a) (Hide b) = a `occursIn` b | ||
| 83 | |||
| 84 | ------------------------------------------------------------------------------- | ||
| 85 | |||
| 86 | isConstructor :: Type a -> Bool | ||
| 87 | isConstructor t = not (isBasicType t) && not (isTVar t) | ||
| 88 | |||
| 89 | ------------------------------------------------------------------------------- | ||
| 90 | |||
| 91 | collectTVar :: Type a -> [TypeBox] | ||
| 92 | collectTVar x@(TVar _) = [Hide x] | ||
| 93 | collectTVar (Prod a b) = collectTVar a ++ collectTVar b | ||
| 94 | collectTVar (List a) = collectTVar a | ||
| 95 | collectTVar (Either a b) = collectTVar a ++ collectTVar b | ||
| 96 | collectTVar (Maybe a) = collectTVar a | ||
| 97 | collectTVar (Set a) = collectTVar a | ||
| 98 | collectTVar (Ord a) = collectTVar a | ||
| 99 | collectTVar (Map a b) = collectTVar a ++ collectTVar b | ||
| 100 | collectTVar (Fun a b) = collectTVar a ++ collectTVar b | ||
| 101 | collectTVar (GC a b) = collectTVar a ++ collectTVar b | ||
| 102 | collectTVar _ = [] | ||
| 103 | |||
| 104 | ------------------------------------------------------------------------------- | ||
| 105 | |||
| 106 | collectTVarTB :: TypeBox -> [TypeBox] | ||
| 107 | collectTVarTB (Hide t) = collectTVar t | ||
| 108 | |||
| 109 | ------------------------------------------------------------------------------- | ||
| 110 | |||
| 111 | getTVarNameTB :: TypeBox -> String | ||
| 112 | getTVarNameTB (Hide (TVar n)) = n | ||
| 113 | getTVarNameTB _ = "" | ||
| 114 | |||
| 115 | ------------------------------------------------------------------------------- |