[get rid of FrontEnd.Type, add routine to apply substitution maps to types, clean up some code.
John Meacham <john@repetae.net>**20061027050821] hunk ./E/FromHs.hs 49
-import FrontEnd.Tc.Type hiding(Rule(..), unbox)
+import FrontEnd.Tc.Type hiding(Rule(..))
hunk ./FrontEnd/Class.hs 49
-import Representation
hunk ./FrontEnd/Class.hs 336
-    tsubst na vv v = applyTyvarMap (msingleton na vv) v
+    tsubst na vv v = applyTyvarMap [(na,vv)] v
hunk ./FrontEnd/DataConsAssump.hs 33
-import HsSyn
-import Representation
+import FrontEnd.KindInfer
hunk ./FrontEnd/DataConsAssump.hs 35
+import HsSyn
hunk ./FrontEnd/DataConsAssump.hs 37
-import Type                     (Types (..))
-import FrontEnd.KindInfer
+import Support.FreeVars
hunk ./FrontEnd/DataConsAssump.hs 89
-   = Map.singleton (toName DataConstructor conName) $ tForAll (tv qualConType) qualConType
+   = Map.singleton (toName DataConstructor conName) $ tForAll (freeVars qualConType) qualConType
hunk ./FrontEnd/DataConsAssump.hs 94
-   = Map.singleton (toName DataConstructor conName) $ tForAll (tv qualConType) qualConType
+   = Map.singleton (toName DataConstructor conName) $ tForAll (freeVars qualConType) qualConType
hunk ./FrontEnd/KindInfer.hs 34
-import FrontEnd.Tc.Type(Sigma())
+import FrontEnd.Tc.Type
hunk ./FrontEnd/KindInfer.hs 42
-import Representation
hunk ./FrontEnd/Tc/Class.hs 19
-import Representation(Class)
hunk ./FrontEnd/Tc/Class.hs 183
-{-
-contextReduce :: Pred -> Tc [Pred]
-conetxtReduce (IsIn c t) = ans where
-    ans = do
-        t' <- evalType t
-        case fromTAp t' of
-            (TCon tycon,as) -> ...
-            t' -> return [IsIn c t']
-contextReduce (IsEq t1 t2) = do
-    t1 <- evalType t1
-    t2 <- evalType t2
-    -}
-
hunk ./FrontEnd/Tc/Class.hs 186
-    liftIO $ putStrLn $ "Asserting entailment: " ++ pprint (qs,ps)
+--    liftIO $ putStrLn $ "Asserting entailment: " ++ pprint (qs,ps)
hunk ./FrontEnd/Tc/Class.hs-boot 4
-import Representation
+import FrontEnd.Tc.Type
hunk ./FrontEnd/Tc/Module.hs 37
-import Representation
hunk ./FrontEnd/Tc/Module.hs 40
-import Type
hunk ./FrontEnd/Tc/Monad.hs 78
-import Type()
hunk ./FrontEnd/Tc/Monad.hs 291
-    let (ps :=> t) = (inst mempty (Map.fromList $ zip (map tyvarAtom as) ts) qt)
+    let (ps :=> t) = (applyTyvarMapQT (zip as ts) qt)
hunk ./FrontEnd/Tc/Monad.hs 326
-    return (TForAll nvs $ inst mempty (Map.fromList $ zip (map tyvarAtom vs) (map TVar nvs)) qt)
+    return (TForAll nvs $ applyTyvarMapQT (zip vs (map TVar nvs)) qt)
hunk ./FrontEnd/Tc/Monad.hs 415
-                Just (aa,bb,tt) -> evalType (applyTyvarMap (fromList $ zip aa as ++ zip bb eas) tt)
+                Just (aa,bb,tt) -> evalType (applyTyvarMap (zip aa as ++ zip bb eas) tt)
hunk ./FrontEnd/Tc/Type.hs 11
+    unfoldKind,
hunk ./FrontEnd/Tc/Type.hs 23
+    Class(),
+    Kindvar(..),
+    tTTuple,
hunk ./FrontEnd/Tc/Type.hs 45
-import qualified Type as T
hunk ./FrontEnd/Tc/Type.hs 67
-applyTyvarMap :: Map.Map Tyvar Type -> Type -> Type
-applyTyvarMap = T.apply
+applyTyvarMap :: [(Tyvar,Type)] -> Type -> Type
+applyTyvarMap ts t = f initMp t where
+    initMp = Map.fromList [ (tyvarAtom v,t) | (v,t) <- ts ]
+    -- XXX name capture!
+    f mp (TForAll as qt) = TForAll as (fq (foldr Map.delete mp (map tyvarAtom as)) qt)
+    f mp (TExists as qt) = TExists as (fq (foldr Map.delete mp (map tyvarAtom as)) qt)
+    f mp (TVar tv) = case Map.lookup (tyvarAtom tv) mp of
+            Just t'  -> t'
+            Nothing -> (TVar tv)
+    f mp t = tickle (f mp) t
+    fq mp (ps :=> t) = map (tickle (f mp)) ps :=> f mp t
+
+applyTyvarMapQT :: [(Tyvar,Type)] -> Qual Type -> Qual Type
+applyTyvarMapQT ts qt = qt' where
+    (TForAll [] qt') = applyTyvarMap ts (TForAll [] qt)
hunk ./FrontEnd/Type.hs 1
-{-------------------------------------------------------------------------------
-
-        Copyright:              Mark Jones and The Hatchet Team
-                                (see file Contributors)
-
-        Module:                 Type
-
-        Description:            Manipulation of types
-
-                                The main tasks implemented by this module are:
-                                        - type substitution
-                                        - type unification
-                                        - type matching
-                                        - type quantification
-
-        Primary Authors:        Mark Jones and Bernie Pope
-
-        Notes:                  See the file License for license information
-
-                                Large parts of this module were derived from
-                                the work of Mark Jones' "Typing Haskell in
-                                Haskell", (http://www.cse.ogi.edu/~mpj/thih/)
-
--------------------------------------------------------------------------------}
-
-module Type (
-    Types (..)
-    ) where
-
-import Control.Monad.Error
-import Control.Monad.Writer
-import Data.IORef
-import List    (union, nub)
-import qualified Data.Map as Map
-
-import GenUtil
-import Name.Name
-import Name.VConsts
-import Representation
-import Support.CanType
-
-
---------------------------------------------------------------------------------
-
-class Types t where
-  apply :: Subst -> t -> t
-  tv    :: t -> [Tyvar]
-
------------------------------------------------------------------------------
-
-
-instance Types t => Types (Qual t) where
-  apply s (ps :=> t) = apply s ps :=> apply s t
-  tv (ps :=> t)      = tv ps `union` tv t
-
-instance Types Pred where
-  apply s (IsIn c t) = IsIn c (apply s t)
-  apply s (IsEq t1 t2) = IsEq (apply s t1) (apply s t2)
-  tv (IsIn c t)      = tv t
-  tv (IsEq t1 t2)      = tv t1 ++ tv t2
-
---------------------------------------------------------------------------------
-
--- substitutions
-type Subst = Map.Map Tyvar Type
-
-nullSubst  :: Subst
-nullSubst   = Map.empty
-
-(+->)      :: Tyvar -> Type -> Subst
-u +-> t     = Map.singleton u t
-
-instance Types Type where
-  apply s x@(TVar var)
-     = case Map.lookup var s of
-          Just t  -> t
-          Nothing -> x
-  apply s (TAp l r)     = TAp (apply s l) (apply s r)
-  apply s (TArrow l r)  = TArrow (apply s l) (apply s r)
-  apply s (TAssoc c cas eas)  = TAssoc c (map (apply s) cas) (map (apply s) cas)
-  apply _ t         = t
-
-  tv (TVar u)      = [u]
-  tv (TAp l r)     = tv l `union` tv r
-  tv (TArrow l r)  = tv l `union` tv r
-  tv (TAssoc _ cas eas) = tv cas `union` tv eas
-  tv _             = []
-
-instance Types a => Types [a] where
-  apply s = map (apply s)              -- it may be worth using a cached version of apply in this circumstance?
-  tv      = nub . concat . map tv
-
-infixr 4 @@
-(@@)       :: Subst -> Subst -> Subst
-s1 @@ s2
-   =(Map.union s1OverS2 s1)
-   where
-   s1OverS2 = mapSubstitution s1 s2
-
-merge      :: Monad m => Subst -> Subst -> m Subst
-merge s1 s2 = if agree then return s else fail $ "merge: substitutions don't agree"
- where
- s = Map.union s1 s2
- agree = all (\v -> (Map.lookup v s1 :: Maybe Type) == Map.lookup v s2 ) $ map fst $ Map.toList $ s1 `Map.intersection` s2
--- agree = all (\v -> apply s1 (TVar v) == apply s2 (TVar v)) $ map fst $ toListFM $ s1 `intersectFM` s2
-
-
-
-mapSubstitution s fm =(Map.map (\v -> apply s v) fm)
-
-
-match :: Monad m => Type -> Type -> m Subst
-
-match x y = do match' x y
-
-match' (TAp l r) (TAp l' r')
-   = do sl <- match l l'
-        sr <- match r r'
-        merge sl sr
-
-match' (TArrow l r) (TArrow l' r')
-   = do sl <- match l l'
-        sr <- match r r'
-        merge sl sr
-
-match' (TVar u) t
-   | getType u == getType t = return (u +-> t)
-
-match' (TCon tc1) (TCon tc2)
-   | tc1==tc2         = return nullSubst
-
-match' t1 t2           = fail $ "match: " ++ show (t1,t2)
-
-
-
rmfile ./FrontEnd/Type.hs
hunk ./FrontEnd/Utils.hs 14
-import Representation()
hunk ./Ho/Type.hs 6
-import FrontEnd.Class(ClassHierarchy)
hunk ./Ho/Type.hs 10
-import FrontEnd.SrcLoc(SrcLoc)
+import FrontEnd.Class(ClassHierarchy)
hunk ./Ho/Type.hs 12
-import HsSyn(Module)
hunk ./Ho/Type.hs 13
+import FrontEnd.SrcLoc(SrcLoc)
+import FrontEnd.Tc.Type(Type())
+import HsSyn(Module)
hunk ./Ho/Type.hs 17
+import Name.Id
hunk ./Ho/Type.hs 20
-import Representation(Type())
hunk ./Ho/Type.hs 21
-import Name.Id
hunk ./Interactive.hs 42
-import Representation
hunk ./data/PrimitiveOperators-in.hs 15
-import Representation
+import FrontEnd.Tc.Type