[Code cleanups, moved functions from TypeUtils to KindInfer. deleted old versions of some routines.
John Meacham <john@repetae.net>**20050502034514] hunk ./FrontEnd/KindInfer.hs 2
--- | 
--- This module implements the Kind Inference algorithm, and the routines which 
+-- |
+-- This module implements the Kind Inference algorithm, and the routines which
hunk ./FrontEnd/KindInfer.hs 8
-                  KindEnv, 
+                  KindEnv,
hunk ./FrontEnd/KindInfer.hs 13
-                  ) where 
+                  aHsTypeToType
+
+                  ) where
hunk ./FrontEnd/KindInfer.hs 18
-import HsSyn  
-import Utils 
+import HsSyn
+import Utils
hunk ./FrontEnd/KindInfer.hs 21
-import DependAnalysis              
+import DependAnalysis
hunk ./FrontEnd/KindInfer.hs 51
-   vars (kind1 `Kfun` kind2) = vars kind1 ++ vars kind2 
+   vars (kind1 `Kfun` kind2) = vars kind1 ++ vars kind2
hunk ./FrontEnd/KindInfer.hs 53
-   apply s Star = Star 
-   apply s (KVar kindvar) 
+   apply s Star = Star
+   apply s (KVar kindvar)
hunk ./FrontEnd/KindInfer.hs 62
-   vars = nub . concatMap vars 
+   vars = nub . concatMap vars
hunk ./FrontEnd/KindInfer.hs 70
-   apply s = Map.map (\el -> apply s el) 
+   apply s = Map.map (\el -> apply s el)
hunk ./FrontEnd/KindInfer.hs 100
-   | u `elem` vars k = fail $ "occurs check failed in kind inference: " ++ 
-                               show u ++ ", " ++ show k  
+   | u `elem` vars k = fail $ "occurs check failed in kind inference: " ++
+                               show u ++ ", " ++ show k
hunk ./FrontEnd/KindInfer.hs 120
-    return a = KI (\_ -> return a) 
+    return a = KI (\_ -> return a)
hunk ./FrontEnd/KindInfer.hs 122
-        = KI (\v  -> comp v >>= \r -> case fun r   of KI x -> x v) 
+        = KI (\v  -> comp v >>= \r -> case fun r   of KI x -> x v)
hunk ./FrontEnd/KindInfer.hs 126
-      env :: KindEnv,     -- the environment of kind assumptions 
+      env :: KindEnv,     -- the environment of kind assumptions
hunk ./FrontEnd/KindInfer.hs 136
---runKI kindEnv (KI comp) = (result, newState) where 
+--runKI kindEnv (KI comp) = (result, newState) where
hunk ./FrontEnd/KindInfer.hs 151
-        
+
hunk ./FrontEnd/KindInfer.hs 158
-instance ContextMonad KI where 
+instance ContextMonad KI where
hunk ./FrontEnd/KindInfer.hs 161
-instance ContextMonad String KI where 
+instance ContextMonad String KI where
hunk ./FrontEnd/KindInfer.hs 166
-    readIORef (kiSubst e) 
+    readIORef (kiSubst e)
hunk ./FrontEnd/KindInfer.hs 170
-    readIORef (kiVarnum e) 
+    readIORef (kiVarnum e)
hunk ./FrontEnd/KindInfer.hs 174
-    readIORef (kiEnv e) 
+    readIORef (kiEnv e)
hunk ./FrontEnd/KindInfer.hs 178
-getEnvVars 
+getEnvVars
hunk ./FrontEnd/KindInfer.hs 180
-        return $ vars e 
+        return $ vars e
hunk ./FrontEnd/KindInfer.hs 184
-    n <- readIORef (kiVarnum e) 
+    n <- readIORef (kiVarnum e)
hunk ./FrontEnd/KindInfer.hs 191
-unify k1 k2 = do 
+unify k1 k2 = do
hunk ./FrontEnd/KindInfer.hs 196
-    --       Right newSubst  -> extendSubst newSubst 
-    --       Left errorMsg -> error $ unlines (reverse c ++ [errorMsg]) 
+    --       Right newSubst  -> extendSubst newSubst
+    --       Left errorMsg -> error $ unlines (reverse c ++ [errorMsg])
hunk ./FrontEnd/KindInfer.hs 207
-newKindVar 
+newKindVar
hunk ./FrontEnd/KindInfer.hs 215
-        return $ Map.lookup name env 
+        return $ Map.lookup name env
hunk ./FrontEnd/KindInfer.hs 222
-    
+
hunk ./FrontEnd/KindInfer.hs 230
-envVarsToStars 
+envVarsToStars
hunk ./FrontEnd/KindInfer.hs 234
- 
+
hunk ./FrontEnd/KindInfer.hs 244
-   depGroups = getDataAndClassBg classAndDataDecls 
+   depGroups = getDataAndClassBg classAndDataDecls
hunk ./FrontEnd/KindInfer.hs 246
-kiKindGroup :: KindGroup -> KI () 
+kiKindGroup :: KindGroup -> KI ()
hunk ./FrontEnd/KindInfer.hs 259
-        
+
hunk ./FrontEnd/KindInfer.hs 261
-kiTyConDecl :: DataDeclHead -> KI () 
+kiTyConDecl :: DataDeclHead -> KI ()
hunk ./FrontEnd/KindInfer.hs 271
-        varKind <- newKindVar 
+        varKind <- newKindVar
hunk ./FrontEnd/KindInfer.hs 288
-                                          return ck 
+                                          return ck
hunk ./FrontEnd/KindInfer.hs 291
-                                       
+
hunk ./FrontEnd/KindInfer.hs 293
-kiQualType varExist qt@(HsQualType cntxt t) = do 
+kiQualType varExist qt@(HsQualType cntxt t) = do
hunk ./FrontEnd/KindInfer.hs 304
-kiType :: Bool -> HsType -> KI Kind 
-kiType _ tap@(HsTyCon name) = do 
+kiType :: Bool -> HsType -> KI Kind
+kiType _ tap@(HsTyCon name) = do
hunk ./FrontEnd/KindInfer.hs 307
-        tyConKind <- lookupKindEnv name 
+        tyConKind <- lookupKindEnv name
hunk ./FrontEnd/KindInfer.hs 309
-           Nothing 
+           Nothing
hunk ./FrontEnd/KindInfer.hs 315
-kiType varExist tap@(HsTyVar name) = do 
+kiType varExist tap@(HsTyVar name) = do
hunk ./FrontEnd/KindInfer.hs 317
-        varKind <- lookupKindEnv name 
+        varKind <- lookupKindEnv name
hunk ./FrontEnd/KindInfer.hs 319
-           Nothing 
+           Nothing
hunk ./FrontEnd/KindInfer.hs 321
-                    True 
-                       -> error $ "kiType: could not find kind for this type variable: " ++ show name  
+                    True
+                       -> error $ "kiType: could not find kind for this type variable: " ++ show name
hunk ./FrontEnd/KindInfer.hs 335
-        unify k1 (k2 `Kfun` varKind) 
-        return varKind 
+        unify k1 (k2 `Kfun` varKind)
+        return varKind
hunk ./FrontEnd/KindInfer.hs 345
-        k2 <- kiType varExist t2 
+        k2 <- kiType varExist t2
hunk ./FrontEnd/KindInfer.hs 348
-        return Star 
+        return Star
hunk ./FrontEnd/KindInfer.hs 357
-        return Star 
+        return Star
hunk ./FrontEnd/KindInfer.hs 360
-newNameVar n 
+newNameVar n
hunk ./FrontEnd/KindInfer.hs 363
-        return (n, newVar) 
+        return (n, newVar)
hunk ./FrontEnd/KindInfer.hs 366
--------------------------------------------------------------------------------- 
+--------------------------------------------------------------------------------
hunk ./FrontEnd/KindInfer.hs 372
-    (_, newState) = unsafePerformIO $ runKI inputEnv $ do 
+    (_, newState) = unsafePerformIO $ runKI inputEnv $ do
hunk ./FrontEnd/KindInfer.hs 379
-    (_, newState) = runKI inputEnv $ do 
+    (_, newState) = runKI inputEnv $ do
hunk ./FrontEnd/KindInfer.hs 391
-getDataAndClassBg decls 
-   = getBindGroups decls getDeclName dataAndClassDeps 
+getDataAndClassBg decls
+   = getBindGroups decls getDeclName dataAndClassDeps
hunk ./FrontEnd/KindInfer.hs 435
-   = (restClassDecls, 
-      newHead:restDataHeads, 
-      context++restContext, 
-      newBodies ++ restDataBodies, 
+   = (restClassDecls,
+      newHead:restDataHeads,
+      context++restContext,
+      newBodies ++ restDataBodies,
hunk ./FrontEnd/KindInfer.hs 441
-   (restClassDecls, restDataHeads, restContext, restDataBodies, restClassBodies) 
+   (restClassDecls, restDataHeads, restContext, restDataBodies, restClassBodies)
hunk ./FrontEnd/KindInfer.hs 447
-   = (restClassDecls, 
-      newHead:restDataHeads, 
-      context++restContext, 
-      newBodies ++ restDataBodies, 
+   = (restClassDecls,
+      newHead:restDataHeads,
+      context++restContext,
+      newBodies ++ restDataBodies,
hunk ./FrontEnd/KindInfer.hs 453
-   (restClassDecls, restDataHeads, restContext, restDataBodies, restClassBodies) 
+   (restClassDecls, restDataHeads, restContext, restDataBodies, restClassBodies)
hunk ./FrontEnd/KindInfer.hs 460
-   = (newClassDecl:restClassDecls, 
-      restDataHeads, 
-      newContext++restContext, 
-      restDataBodies, 
+   = (newClassDecl:restClassDecls,
+      restDataHeads,
+      newContext++restContext,
+      restDataBodies,
hunk ./FrontEnd/KindInfer.hs 468
-   --rn = runIdentity $ applyTU (full_tdTU $ adhocTU (constTU ([])) f) newClassBodies 
+   --rn = runIdentity $ applyTU (full_tdTU $ adhocTU (constTU ([])) f) newClassBodies
hunk ./FrontEnd/KindInfer.hs 471
-   rn = Seq.toList $ everything (Seq.<>) (mkQ Seq.empty f) newClassBodies 
+   rn = Seq.toList $ everything (Seq.<>) (mkQ Seq.empty f) newClassBodies
hunk ./FrontEnd/KindInfer.hs 494
-kindOf name env 
+kindOf name env
hunk ./FrontEnd/KindInfer.hs 501
-kindOfClass name env 
+kindOfClass name env
hunk ./FrontEnd/KindInfer.hs 510
-    
+
hunk ./FrontEnd/KindInfer.hs 528
--- here we also qualify the type constructor if it is 
+-- here we also qualify the type constructor if it is
hunk ./FrontEnd/KindInfer.hs 542
--- perhaps there should be a version that is 
+-- perhaps there should be a version that is
hunk ./FrontEnd/KindInfer.hs 550
-   vars = tv qt 
+   vars = tv qt
hunk ./FrontEnd/KindInfer.hs 554
-   -- = IsIn className (TVar $ Tyvar varName (kindOf varName kt)) 
-   = IsIn className (TVar $ tyvar varName (head $ kindOfClass className kt)) 
- 
+   -- = IsIn className (TVar $ Tyvar varName (kindOf varName kt))
+   = IsIn className (TVar $ tyvar varName (head $ kindOfClass className kt))
+
hunk ./FrontEnd/KindInfer.hs 558
-hsQualTypeToScheme kt qualType =  return $ aHsQualTypeToScheme newEnv qualType where  
-   newEnv = kiHsQualType kt qualType 
+hsQualTypeToScheme kt qualType =  return $ aHsQualTypeToScheme newEnv qualType where
+   newEnv = kiHsQualType kt qualType
hunk ./FrontEnd/TIMain.hs 50
-import TypeUtils                (aHsTypeSigToAssumps)
hunk ./FrontEnd/TypeUtils.hs 23
-import HsSyn    
-import Representation      
+import HsSyn
+import Representation
hunk ./FrontEnd/TypeUtils.hs 26
-import Type                     (tv, 
-                                 quantify, 
+import Type                     (tv,
+                                 quantify,
hunk ./FrontEnd/TypeUtils.hs 34
-import KindInfer                (KindEnv, 
-                            --     kiHsQualType,
-                                hsQualTypeToScheme,
-                                 kindOf)
+import KindInfer
hunk ./FrontEnd/TypeUtils.hs 38
--------------------------------------------------------------------------------------------
---
---  The conversion functions:
---
---    aHsTypeToType
-
---------------------------------------------------------------------------------
-    
--- note that the types are generated without generalised type
--- variables, ie there will be no TGens in the output
--- to get the generalised variables a second phase
--- of generalisation must be applied
-
-aHsTypeToType :: KindEnv -> HsType -> Type
-
--- arrows
-
-aHsTypeToType kt (HsTyFun t1 t2)
-   = aHsTypeToType kt t1 `fn` aHsTypeToType kt t2
-
--- tuples
-
-aHsTypeToType kt tuple@(HsTyTuple types)
-   = tTTuple $ map (aHsTypeToType kt) types
-
--- application
-
-aHsTypeToType kt (HsTyApp t1 t2)
-   = TAp (aHsTypeToType kt t1) (aHsTypeToType kt t2)
-
--- variables, we must know the kind of the variable here!
--- they are assumed to already exist in the kindInfoTable
--- which was generated by the process of KindInference
-
-aHsTypeToType kt (HsTyVar name)
-   = TVar $ tyvar  name (kindOf name kt)
-
--- type constructors, we must know the kind of the constructor.
--- here we also qualify the type constructor if it is 
--- currently unqualified
-
-aHsTypeToType kt (HsTyCon name)
-   = TCon $ Tycon name (kindOf name kt)
-
-aHsQualTypeToQualType :: KindEnv -> HsQualType -> Qual Type
-aHsQualTypeToQualType kt (HsQualType cntxt t)
-   = map (aHsAsstToPred kt) cntxt :=> aHsTypeToType kt t
-aHsQualTypeToQualType kt (HsUnQualType t)
-   = [] :=> aHsTypeToType kt t
-
--- this version quantifies all the type variables
--- perhaps there should be a version that is 
--- parameterised with which variables to quantify
-
-aHsQualTypeToScheme :: KindEnv -> HsQualType -> Scheme
-aHsQualTypeToScheme kt qualType
-   = quantify vars qt
-   where
-   qt = aHsQualTypeToQualType kt qualType
-   vars = tv qt 
-
hunk ./FrontEnd/TypeUtils.hs 46
-   scheme = aHsQualTypeToScheme newEnv qualType 
-   --newEnv = kiHsQualType kt qualType 
+   scheme = aHsQualTypeToScheme newEnv qualType
+   --newEnv = kiHsQualType kt qualType
hunk ./FrontEnd/TypeUtils.hs 52
-
hunk ./FrontEnd/TypeUtils.hs 54
-   -- = IsIn className (TVar $ Tyvar varName (kindOf varName kt)) 
-   = IsIn className (TVar $ tyvar varName (kindOf className kt)) 
+   -- = IsIn className (TVar $ Tyvar varName (kindOf varName kt))
+   = IsIn className (TVar $ tyvar varName (kindOf className kt))
hunk ./FrontEnd/TypeUtils.hs 63
-   --scheme = aHsQualTypeToScheme newEnv qualType 
-   --newEnv = kiHsQualType kt qualType 
+   --scheme = aHsQualTypeToScheme newEnv qualType
+   --newEnv = kiHsQualType kt qualType
hunk ./FrontEnd/TypeUtils.hs 84
-qualifyAssump :: Module -> Assump -> Assump 
+qualifyAssump :: Module -> Assump -> Assump
hunk ./FrontEnd/TypeUtils.hs 86
-   | isQual ident = assump  -- do nothing 
+   | isQual ident = assump  -- do nothing
hunk ./FrontEnd/TypeUtils.hs 92
-   ident = assumpId assump 
+   ident = assumpId assump