Commit bb6a7d1a authored by rl@cse.unsw.edu.au's avatar rl@cse.unsw.edu.au
Browse files

Add PA dfuns to VectInfo

parent 813725ad
......@@ -599,11 +599,12 @@ tcIfaceVectInfo mod typeEnv (IfaceVectInfo
= do { vVars <- mapM vectVarMapping vars
; tyConRes1 <- mapM vectTyConMapping tycons
; tyConRes2 <- mapM vectTyConReuseMapping tycons
; let (vTyCons, vDataCons, vIsos) = unzip3 (tyConRes1 ++ tyConRes2)
; let (vTyCons, vDataCons, vPAs, vIsos) = unzip4 (tyConRes1 ++ tyConRes2)
; return $ VectInfo
{ vectInfoVar = mkVarEnv vVars
, vectInfoTyCon = mkNameEnv vTyCons
, vectInfoDataCon = mkNameEnv (concat vDataCons)
, vectInfoPADFun = mkNameEnv vPAs
, vectInfoIso = mkNameEnv vIsos
}
}
......@@ -617,25 +618,31 @@ tcIfaceVectInfo mod typeEnv (IfaceVectInfo
}
vectTyConMapping name
= do { vName <- lookupOrig mod (mkVectTyConOcc (nameOccName name))
; paName <- lookupOrig mod (mkPADFunOcc (nameOccName name))
; isoName <- lookupOrig mod (mkVectIsoOcc (nameOccName name))
; let { tycon = lookupTyCon name
; vTycon = lookupTyCon vName
; paTycon = lookupVar paName
; isoTycon = lookupVar isoName
}
; vDataCons <- mapM vectDataConMapping (tyConDataCons tycon)
; return ((name, (tycon, vTycon)), -- (T, T_v)
vDataCons, -- list of (Ci, Ci_v)
(name, (tycon, paTycon)), -- (T, paT)
(name, (tycon, isoTycon))) -- (T, isoT)
}
vectTyConReuseMapping name
= do { isoName <- lookupOrig mod (mkVectIsoOcc (nameOccName name))
= do { paName <- lookupOrig mod (mkPADFunOcc (nameOccName name))
; isoName <- lookupOrig mod (mkVectIsoOcc (nameOccName name))
; let { tycon = lookupTyCon name
; paTycon = lookupVar paName
; isoTycon = lookupVar isoName
; vDataCons = [ (dataConName dc, (dc, dc))
| dc <- tyConDataCons tycon]
}
; return ((name, (tycon, tycon)), -- (T, T)
vDataCons, -- list of (Ci, Ci)
(name, (tycon, paTycon)), -- (T, paT)
(name, (tycon, isoTycon))) -- (T, isoT)
}
vectDataConMapping datacon
......
......@@ -1302,6 +1302,7 @@ data VectInfo
vectInfoVar :: VarEnv (Var , Var ), -- (f, f_v) keyed on f
vectInfoTyCon :: NameEnv (TyCon , TyCon), -- (T, T_v) keyed on T
vectInfoDataCon :: NameEnv (DataCon, DataCon), -- (C, C_v) keyed on C
vectInfoPADFun :: NameEnv (TyCon , Var), -- (C, paT) keyed on T
vectInfoIso :: NameEnv (TyCon , Var) -- (T, isoT) keyed on T
}
-- all of this is always tidy, even in ModGuts
......@@ -1325,13 +1326,14 @@ data IfaceVectInfo
}
noVectInfo :: VectInfo
noVectInfo = VectInfo emptyVarEnv emptyNameEnv emptyNameEnv emptyNameEnv
noVectInfo = VectInfo emptyVarEnv emptyNameEnv emptyNameEnv emptyNameEnv emptyNameEnv
plusVectInfo :: VectInfo -> VectInfo -> VectInfo
plusVectInfo vi1 vi2 =
VectInfo (vectInfoVar vi1 `plusVarEnv` vectInfoVar vi2)
(vectInfoTyCon vi1 `plusNameEnv` vectInfoTyCon vi2)
(vectInfoDataCon vi1 `plusNameEnv` vectInfoDataCon vi2)
(vectInfoPADFun vi1 `plusNameEnv` vectInfoPADFun vi2)
(vectInfoIso vi1 `plusNameEnv` vectInfoIso vi2)
noIfaceVectInfo :: IfaceVectInfo
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment