module TypedIds where
import Maybe(isJust)
import Data.Generics

{-+
Haskell declaration introduce names in two name spaces. Type classes and
types live in one name space. Values (functions, data constructors) live
in another name space.
-}

data NameSpace = ClassOrTypeNames | ValueNames     deriving (Eq,Ord,Show, Data, Typeable)


{-+
Identifiers can denote many different types of entities. It is clear from
the defining occurence of an identifier what type of entity it denotes.

The type #IdTy# can be seen as a refinement of #NameSpace#.
From the use of an identifier, we can tell what name space it refers
to, but not the exact type of entity, hence the need for two different types.
-}

data IdTy i 
    = Value 
    | FieldOf i (TypeInfo i)
    | MethodOf i Int [i] -- name of class, number of superclasses, names of all methods
    | ConstrOf i (TypeInfo i)
    | Class Int [i] -- number of superclasses, names of all methods
    | Type (TypeInfo i)
    | Assertion -- P-Logic assertion name
    | Property  -- P-Logic property name
        deriving (Eq,Ord,Show,Read, Data, Typeable)
        -- These structures contain a lot of redundancy, so we shouldn't really
	-- use any comparison operations on them.

data ConInfo i = ConInfo 
    { conName :: i
    , conArity :: Int
    , conFields :: Maybe [i] -- length agrees with conArity
    } deriving (Eq,Ord,Show,Read, Data, Typeable)

data DefTy     = Newtype | Data | Synonym | Primitive
               deriving (Eq,Ord,Show,Read, Data, Typeable)

data TypeInfo i = TypeInfo
    { defType       :: Maybe DefTy
    , constructors  :: [ConInfo i]
    , fields        :: [i]
    } deriving (Eq,Ord,Show,Read, Data, Typeable)

blankTypeInfo = TypeInfo { defType = Nothing, constructors = [], fields = [] }



instance Functor ConInfo where
    fmap f c = c { conName = f (conName c),
		   conFields = fmap (map f) (conFields c) }

instance Functor TypeInfo where
    fmap f t = t { constructors = map (fmap f) (constructors t)
                 , fields = map f (fields t)
                 }

instance Functor IdTy where
    fmap f (FieldOf x tyInfo)   = FieldOf (f x) (fmap f tyInfo)
    fmap f (MethodOf x n xs)      = MethodOf (f x) n (map f xs)
    fmap f (ConstrOf t tyInfo)  = ConstrOf (f t) (fmap f tyInfo)
    fmap _ Value                = Value
    fmap f (Class n xs)         = Class n (f `map` xs)
    fmap f (Type tyInfo)        = Type (fmap f tyInfo)
    fmap _ Assertion            = Assertion
    fmap _ Property             = Property

class HasNameSpace t where
    namespace :: t -> NameSpace

instance HasNameSpace (IdTy id) where
    namespace Value         = ValueNames
    namespace (FieldOf {}) = ValueNames
    namespace (MethodOf {}) = ValueNames
    namespace (ConstrOf {}) = ValueNames
    namespace (Class {})    = ClassOrTypeNames
    namespace (Type {})     = ClassOrTypeNames
    namespace Assertion     = ValueNames -- hmm
    namespace Property      = ValueNames -- hmm


-- owner :: IdTy i -> Maybe i
owner (FieldOf dt  _) = Just dt
owner (MethodOf cl _ _) = Just cl
owner (ConstrOf dt _) = Just dt
owner _               = Nothing


-- isSubordinate :: IdTy i -> Bool
isSubordinate = isJust . owner

-- belongsTo :: idTy i -> i -> Bool
idty `belongsTo` t = owner idty == Just t

isAssertion Assertion = True
isAssertion Property  = True
isAssertion _         = False

isClassOrType,isValue :: HasNameSpace t => t -> Bool
isClassOrType   = (== ClassOrTypeNames) . namespace
isValue         = (== ValueNames)       . namespace

class HasIdTy i t | t->i where
  idTy :: t -> IdTy i

instance HasIdTy i (IdTy i) where idTy = id
--instance HasNameSpace NameSpace where namespace = id