-genTypeKind :: GenType -> Kind
-genTypeKind (GenTypeCons _) = KStar
-genTypeKind (GenTypeVar _) = KStar
-genTypeKind (GenTypeArrow l r) = genTypeKind l KArrow genTypeKind r
-genTypeKind (GenTypeApp l r) = genTypeKind l KArrow genTypeKind r
+genTypeKind :: [GenType] -> Kind
+genTypeKind ts = foldr (KArrow) KStar $ map snd $ sortBy ((<) `on` fst) $ foldr (\t->gt t id) [] ts
+where
+ gt :: GenType (Kind -> Kind) [(Int, Kind)] -> [(Int, Kind)]
+ gt (GenTypeCons _) c ks = ks
+ gt (GenTypeVar i) c ks = case lookup i ks of
+ Nothing = [(i, c KStar):ks]
+ Just KStar = [(i, c KStar):filter ((<>)i o fst) ks]
+ Just _ = ks
+ gt (GenTypeArrow l r) c ks = gt l id $ gt r id ks
+ gt (GenTypeApp l r) c ks = gt l ((KArrow) KStar o c) $ gt r id ks
+instance toString Kind where toString k = concat $ print k []
+instance print Kind
+where
+ print KStar c = ["*":c]
+ print (l KArrow r) c = ["(":print l ["->":print r [")":c]]]