make dataConInstPat take a list of FastStrings rather than OccNames, remove out-of...

Mon Sep 18 17:15:25 EDT 2006  Manuel M T Chakravarty <chak@cse.unsw.edu.au>
  * make dataConInstPat take a list of FastStrings rather than OccNames, remove out-of-date comment
  Sun Aug  6 20:52:24 EDT 2006  Manuel M T Chakravarty <chak@cse.unsw.edu.au>
    * make dataConInstPat take a list of FastStrings rather than OccNames, remove out-of-date comment
    Wed Aug  2 09:26:47 EDT 2006  kevind@bu.edu

diff --git a/compiler/basicTypes/MkId.lhs b/compiler/basicTypes/MkId.lhs
index 04f69f7..6c9029c 100644 (file)
--- a/compiler/basicTypes/MkId.lhs
+++ b/compiler/basicTypes/MkId.lhs
@@ -551,9 +551,7 @@ mkRecordSelId tycon field_label
        --      foo = /\a. \t:T. case t of { MkT f -> f a }
 
     mk_alt data_con 
-      =        -- In the non-vanilla case, the pattern must bind type variables and
-               -- the context stuff; hence the arg_prefix binding below
-         ASSERT2( res_ty `tcEqType` field_tau, ppr data_con $$ ppr res_ty $$ ppr field_tau )
+      =   ASSERT2( res_ty `tcEqType` field_tau, ppr data_con $$ ppr res_ty $$ ppr field_tau )
          mkReboxingAlt rebox_uniqs data_con (ex_tvs ++ co_tvs ++ arg_vs) rhs
       where
            -- get pattern binders with types appropriately instantiated

diff --git a/compiler/coreSyn/CoreUtils.lhs b/compiler/coreSyn/CoreUtils.lhs
index 76d742c..b798379 100644 (file)
--- a/compiler/coreSyn/CoreUtils.lhs
+++ b/compiler/coreSyn/CoreUtils.lhs
@@ -33,7 +33,7 @@ module CoreUtils (
        -- Equality
        cheapEqExpr, tcEqExpr, tcEqExprX, applyTypeToArgs, applyTypeToArg,
 
-        dataConOrigInstPat, dataConRepInstPat, dataConRepOccInstPat
+        dataConOrigInstPat, dataConRepInstPat, dataConRepFSInstPat
     ) where
 
 #include "HsVersions.h"
@@ -46,7 +46,7 @@ import CoreFVs                ( exprFreeVars )
 import PprCore         ( pprCoreExpr )
 import Var             ( Var, TyVar, CoVar, isCoVar, tyVarKind, setVarUnique,
                           mkCoVar, mkTyVar, mkCoVar )
-import OccName          ( OccName, occNameFS, mkVarOcc )
+import OccName          ( OccName, occNameFS, mkVarOccFS )
 import VarSet          ( unionVarSet )
 import VarEnv
 import Name            ( hashName, mkSysTvName )
@@ -88,7 +88,7 @@ import Outputable
 import DynFlags                ( DynFlags, DynFlag(Opt_DictsCheap), dopt )
 import TysPrim         ( alphaTy )     -- Debugging only
 import Util             ( equalLength, lengthAtLeast, foldl2 )
-import FastString       ( mkFastString )
+import FastString       ( FastString )
 \end{code}
 
 
@@ -681,16 +681,18 @@ deepCast ty tyVars co
     coArgs = decomposeCo (length tyVars) co
 
 -- These InstPat functions go here to avoid circularity between DataCon and Id
-dataConOrigInstPat   = dataConInstPat dataConOrigArgTys
-dataConRepInstPat    = dataConInstPat dataConRepArgTys
-dataConRepOccInstPat = dataConOccInstPat dataConRepArgTys
-
-dataConInstPat :: (DataCon -> [Type])       -- function used to find arg tys
-               -> [Unique]                  -- A long enough list of uniques, at least one for each binder
-               -> DataCon
-              -> [Type]                    -- Types to instantiate the universally quantified tyvars
-              -> ([TyVar], [CoVar], [Id])  -- Return instantiated variables
--- dataConInstPat us con inst_tys returns a triple (ex_tvs, co_tvs, arg_ids),
+dataConOrigInstPat   = dataConInstPat dataConOrigArgTys (repeat (FSLIT("ipv")))
+dataConRepInstPat    = dataConInstPat dataConRepArgTys (repeat (FSLIT("ipv")))
+dataConRepFSInstPat = dataConInstPat dataConRepArgTys
+
+dataConInstPat :: (DataCon -> [Type])      -- function used to find arg tys
+                  -> [FastString]          -- A long enough list of FSs to use for names
+                  -> [Unique]              -- An equally long list of uniques, at least one for each binder
+                  -> DataCon
+                 -> [Type]                -- Types to instantiate the universally quantified tyvars
+              -> ([TyVar], [CoVar], [Id]) -- Return instantiated variables
+-- dataConInstPat arg_fun us fss con inst_tys returns a triple 
+-- (ex_tvs, co_tvs, arg_ids),
 --
 --   ex_tvs are intended to be used as binders for existential type args
 --
@@ -716,25 +718,8 @@ dataConInstPat :: (DataCon -> [Type])       -- function used to find arg tys
 --  ([a1'', a2'', b''],[c :: (a1',a2'):=:(a1'',a2'')],[x :: Int,y :: b''])
 --
 --  where the double-primed variables are created from the unique list input
-dataConInstPat arg_fun uniqs con inst_tys 
-  = dataConOccInstPat arg_fun uniqs occs con inst_tys
-  where
-     -- dataConOccInstPat doesn't actually make use of the OccName directly for
-     -- existential and coercion variable binders, so it is right to just
-     -- use the VarName namespace for all of the OccNames
-    occs      = mk_occs 1
-    mk_occs n = mkVarOcc ("ipv" ++ show n) : mk_occs (n+1)
-
-dataConOccInstPat :: (DataCon -> [Type])       -- function used to find arg tys
-                  -> [Unique]                  -- A long enough list of uniques, at least one for each binder
-                  -> [OccName]                 -- An equally long list of OccNames to use
-                  -> DataCon
-                 -> [Type]                    -- Types to instantiate the universally quantified tyvars
-              -> ([TyVar], [CoVar], [Id])  -- Return instantiated variables
--- This function actually does the job specified in the comment for 
--- dataConInstPat, but uses the specified list of OccNames.  This is 
--- is necessary for use in e.g. tcIfaceDataAlt
-dataConOccInstPat arg_fun uniqs occs con inst_tys 
+--  getting names from the FS list input
+dataConInstPat arg_fun fss uniqs con inst_tys 
   = (ex_bndrs, co_bndrs, id_bndrs)
   where 
     univ_tvs = dataConUnivTyVars con
@@ -747,34 +732,34 @@ dataConOccInstPat arg_fun uniqs occs con inst_tys
     n_co = length eq_spec
     n_id = length arg_tys
 
-      -- split the Uniques and OccNames
+      -- split the Uniques and FastStrings
     (ex_uniqs, uniqs')   = splitAt n_ex uniqs
     (co_uniqs, id_uniqs) = splitAt n_co uniqs'
 
-    (ex_occs, occs')     = splitAt n_ex occs
-    (co_occs, id_occs)   = splitAt n_co occs'
+    (ex_fss, fss')     = splitAt n_ex fss
+    (co_fss, id_fss)   = splitAt n_co fss'
 
       -- make existential type variables
-    mk_ex_var uniq occ var = mkTyVar new_name kind
+    mk_ex_var uniq fs var = mkTyVar new_name kind
       where
-        new_name = mkSysTvName uniq (occNameFS occ)
+        new_name = mkSysTvName uniq fs
         kind     = tyVarKind var
 
-    ex_bndrs = zipWith3 mk_ex_var ex_uniqs ex_occs ex_tvs
+    ex_bndrs = zipWith3 mk_ex_var ex_uniqs ex_fss ex_tvs
 
       -- make the instantiation substitution
     inst_subst = substTyWith (univ_tvs ++ ex_tvs) (inst_tys ++ map mkTyVarTy ex_bndrs)
 
       -- make new coercion vars, instantiating kind
-    mk_co_var uniq occ eq_pred = mkCoVar new_name (inst_subst (mkPredTy eq_pred))
+    mk_co_var uniq fs eq_pred = mkCoVar new_name (inst_subst (mkPredTy eq_pred))
        where
-         new_name = mkSysTvName uniq (occNameFS occ)
+         new_name = mkSysTvName uniq fs
 
-    co_bndrs = zipWith3 mk_co_var co_uniqs co_occs eq_preds
+    co_bndrs = zipWith3 mk_co_var co_uniqs co_fss eq_preds
 
       -- make value vars, instantiating types
-    mk_id_var uniq occ ty = mkUserLocal occ uniq (inst_subst ty) noSrcLoc
-    id_bndrs = zipWith3 mk_id_var id_uniqs id_occs arg_tys
+    mk_id_var uniq fs ty = mkUserLocal (mkVarOccFS fs) uniq (inst_subst ty) noSrcLoc
+    id_bndrs = zipWith3 mk_id_var id_uniqs id_fss arg_tys
 
 exprIsConApp_maybe :: CoreExpr -> Maybe (DataCon, [CoreExpr])
 -- Returns (Just (dc, [x1..xn])) if the argument expression is 

diff --git a/compiler/iface/TcIface.lhs b/compiler/iface/TcIface.lhs
index 6d95d08..90bedd9 100644 (file)
--- a/compiler/iface/TcIface.lhs
+++ b/compiler/iface/TcIface.lhs
@@ -35,7 +35,7 @@ import HscTypes               ( ExternalPackageState(..),
                          emptyModDetails, lookupTypeEnv, lookupType, typeEnvIds )
 import InstEnv         ( Instance(..), mkImportedInstance )
 import CoreSyn
-import CoreUtils       ( exprType, dataConRepOccInstPat )
+import CoreUtils       ( exprType, dataConRepFSInstPat )
 import CoreUnfold
 import CoreLint                ( lintUnfolding )
 import WorkWrap                ( mkWrapper )
@@ -53,7 +53,7 @@ import Var            ( TyVar, mkTyVar, tyVarKind )
 import Name            ( Name, nameModule, nameIsLocalOrFrom, isWiredInName,
                          nameOccName, wiredInNameTyThing_maybe )
 import NameEnv
-import OccName         ( OccName, mkVarOccFS, mkTyVarOccoccNameSpace, pprNameSpace  )
+import OccName         ( OccName, mkVarOccFS, mkTyVarOccoccNameSpace, pprNameSpace, occNameFS  )
 import FastString       ( FastString )
 import Module          ( Module, moduleName )
 import UniqFM          ( lookupUFM )
@@ -680,7 +680,7 @@ tcIfaceAlt (tycon, inst_tys) (IfaceTupleAlt boxity, arg_occs, rhs)
 tcIfaceDataAlt con inst_tys arg_strs rhs
   = do { us <- newUniqueSupply
        ; let uniqs = uniqsFromSupply us
-       ; let   (ex_tvs, co_tvs, arg_ids) = dataConOccInstPat uniqs arg_occs con inst_tys
+       ; let   (ex_tvs, co_tvs, arg_ids) = dataConRepFSInstPat (map occNameFS arg_strs) uniqs con inst_tys
                 all_tvs                   = ex_tvs ++ co_tvs
 
        ; rhs' <- extendIfaceTyVarEnv all_tvs   $