TiClasses.hs

Plain Haskell source file: TiClasses.hs 

module TiClasses where
import TiMonad(TI,KI)
import TiTypes
import TiKinds
import List(nub)
import MUtils

type TypedDecls i ds = Typing ds (DeclsType i)
type DeclsType i = ([Typing (HsIdentI i) (Kind,TypeInfo i)],[Assump i])
(xs1,ys1)+++(xs2,ys2) = (xs1++xs2,ys1++ys2)

class AddDeclsType i d | d->i where
  addDeclsType :: DeclsType i -> d -> d
  addDeclsType _ d = d


Although their syntax are different, and they are type checked differently,
the base syntax uses *the same* type for, top level declarations,
local declarations, declarations in class definitions and declarations
in instance definitions. Obviously we can't use the same overloaded function
for type checking all of them...

type CheckDecls i s r = s -> TI i (TypedDecls i r)

class TypeCheckDecls i s r {-| s->r-} where
  tcTopDecls, tcInstDecls --,tcLocalDecls' --, tcClassDecls
    :: CheckDecls i s r
  --tcLocalDecls' = tcTopDecls

class TypeCheckDecl i s r where
  tcDecl :: [Assump i] -> s -> TI i r

tcLocalDecls ds = fmap snd # tcTopDecls ds -- discard kind env

class TypeCheck i s r {-| s->r-} where tc :: s -> TI i r
class KindCheck i t r | t->r where kc :: t -> KI i r


instance KindCheck t r=> KindCheck [t] [r] where
  kc = mapM kc
  
instance (KindCheck t1 r1,
	  KindCheck t2 r2) => KindCheck (t1,t2) (r1,r2) where
  kc (t1,t2) = (,) # kc t1 <# kc t2

--instance TypeCheck s r => TypeCheck [s] [r] where tc = mapM tc

class HasId i e | e->i where
  ident :: HsIdentI i -> e
  isId :: e -> Maybe (HsIdentI i)

var x = ident (HsVar x)

isVar e = do HsVar x <- isId e
	     return x

class HasId i e => HasCoreSyntax i e | e->i where
  app :: e -> e -> e
  tuple,list :: [e] -> e
--paren :: e -> e

class HasCoreSyntax i e => HasTypeApp i e | e->i where
  spec :: HsIdentI i -> [Type i] -> e

class HasAbstr i e | e->i where
  abstract :: [i] -> e -> e

class (HasAbstr i s) => HasLocalDef i e s | s->e i where
  letvar :: Typing i (Type i) -> e -> s -> s

--letvar x e1 e2 = abstract [x] e2 `app` e1

instance HasAbstr i e => HasAbstr i [e] where
  abstract = map . abstract

instance HasLocalDef i e s => HasLocalDef i e [s] where
  letvar x e1 = map (letvar x e1)

class HasDef ds d | ds->d where
  noDef :: ds
  consDef :: d -> ds -> ds
  appendDef :: ds -> ds -> ds
  toDefs :: [d] -> ds

  toDefs = foldr consDef noDef

--class Decorate s i where decorate :: i -> s -> s
Index