[clean up kind inference
John Meacham <john@repetae.net>**20051206090331] hunk ./FrontEnd/KindInfer.hs 42
-
---------------------------------------------------------------------------------
-
--- the many interesting types and classes
-
-newtype KindEnv = KindEnv (Map.Map HsName Kind)
+newtype KindEnv = KindEnv (Map.Map Name Kind)
hunk ./FrontEnd/KindInfer.hs 133
-data State = State {
-      env :: KindEnv,     -- the environment of kind assumptions
-      subst :: Subst     -- the current substitution
-   }
hunk ./FrontEnd/KindInfer.hs 134
-
hunk ./FrontEnd/KindInfer.hs 135
-restrictKindEnv f (KindEnv m) = KindEnv $ Map.filterWithKey (\k _ -> f k) m
+restrictKindEnv f (KindEnv m) = KindEnv $ Map.filterWithKey (\k _ -> f (nameName k)) m
hunk ./FrontEnd/KindInfer.hs 141
---runKI     :: KindEnv -> KI a -> (a, State)
---runKI kindEnv (KI comp) = (result, newState) where
---   (result,newState) = comp (State { context = [], env = kindEnv, subst = nullSubst, varnum = 0})
-
-runKI :: KindEnv -> KI a -> IO (a, State)
+runKI :: KindEnv -> KI a -> IO (a, KindEnv)
hunk ./FrontEnd/KindInfer.hs 151
-        subst <- readIORef (kiSubst e)
-        return (x,State { env = env, subst = subst })
+        return (x,env)
hunk ./FrontEnd/KindInfer.hs 199
-lookupKindEnv :: HsName -> KI (Maybe Kind)
+lookupKindEnv :: Name -> KI (Maybe Kind)
hunk ./FrontEnd/KindInfer.hs 220
-getConstructorKinds (KindEnv m) = Map.fromList [ (toName TypeConstructor x,y) | (x,y)<- Map.toList m]
+getConstructorKinds (KindEnv m) = m -- Map.fromList [ (toName TypeConstructor x,y) | (x,y)<- Map.toList m]
hunk ./FrontEnd/KindInfer.hs 227
-kiDecls inputEnv classAndDataDecls = run >>= return . env . snd  where
+kiDecls inputEnv classAndDataDecls = run >>= return . snd where
hunk ./FrontEnd/KindInfer.hs 251
-        let newEnv = KindEnv $ Map.fromList $ [(tyconName, tyConKind)] ++ argKindVars
+        let newEnv = KindEnv $ Map.fromList $ [(toName TypeConstructor tyconName, tyConKind)] ++ argKindVars
hunk ./FrontEnd/KindInfer.hs 258
-        let newEnv = KindEnv $ Map.fromList $ (className, varKind): [(argName, varKind) | argName <- argNames]
+        let newEnv = KindEnv $ Map.fromList $ (toName ClassName className, varKind): [(toName TypeVal argName, varKind) | argName <- argNames]
hunk ./FrontEnd/KindInfer.hs 265
-    classKind <- lookupKindEnv className
+    classKind <- lookupKindEnv (toName ClassName className)
hunk ./FrontEnd/KindInfer.hs 268
-           Just ck -> do argKind <- lookupKindEnv argName
+           Just ck -> do argKind <- lookupKindEnv (toName TypeVal argName)
hunk ./FrontEnd/KindInfer.hs 272
-					  extendEnv $ KindEnv $ Map.singleton argName varKind
+					  extendEnv $ KindEnv $ Map.singleton (toName TypeVal argName) varKind
hunk ./FrontEnd/KindInfer.hs 293
-        tyConKind <- lookupKindEnv name
+        tyConKind <- lookupKindEnv (toName TypeConstructor name)
hunk ./FrontEnd/KindInfer.hs 303
-        varKind <- lookupKindEnv name
+        varKind <- lookupKindEnv (toName TypeVal name)
hunk ./FrontEnd/KindInfer.hs 310
-				extendEnv $ KindEnv $ Map.singleton name varKind
+				extendEnv $ KindEnv $ Map.singleton (toName TypeVal name) varKind
hunk ./FrontEnd/KindInfer.hs 351
-newNameVar :: HsName -> KI (HsName, Kind)
+newNameVar :: HsName -> KI (Name, Kind)
hunk ./FrontEnd/KindInfer.hs 354
-    return (n, newVar)
+    return (toName TypeVal n, newVar)
hunk ./FrontEnd/KindInfer.hs 362
-kiHsQualType inputEnv qualType = env newState where
+kiHsQualType inputEnv qualType = newState where
hunk ./FrontEnd/KindInfer.hs 483
-   = case Map.lookup name env of
-        Nothing -> Star
-        Nothing -> error $ "kindOf: could not find kind of : " ++ show name
+   = case Map.lookup (toName TypeConstructor name) env of
+        Nothing -> case Map.lookup (toName TypeVal name) env of
+            Nothing -> Star
+            Just k -> k
+        --Nothing -> error $ "kindOf: could not find kind of : " ++ show name
hunk ./FrontEnd/KindInfer.hs 492
-   = case Map.lookup name env of
+   = case Map.lookup (toName ClassName name) env of
hunk ./test/Forall.hs 74
-f (Bob x) = x 'y'
+--f (Bob x) = x 'y'
hunk ./test/Forall.hs 77
-    putChar $ f (Bob id)
+--    putChar $ f (Bob id)