Change TypeSig and GenericSig to take a list of names (fixes #1595).

This is a merge of a patch contributed by Michal Terepeta and the
recent generics changes.

12 files changed, 73 insertions, 75 deletions

diff --git a/compiler/deSugar/DsMeta.hs b/compiler/deSugar/DsMeta.hs
index a4b47ee504..ab1c1e35e8 100644
--- a/compiler/deSugar/DsMeta.hs
+++ b/compiler/deSugar/DsMeta.hs
@@ -419,7 +419,7 @@ rep_sigs' sigs = do { sigs1 <- mapM rep_sig sigs ;
 rep_sig :: LSig Name -> DsM [(SrcSpan, Core TH.DecQ)]
 	-- Singleton => Ok
 	-- Empty     => Too hard, signature ignored
-rep_sig (L loc (TypeSig nm ty))       = rep_proto nm ty loc
+rep_sig (L loc (TypeSig nms ty))      = rep_proto nms ty loc
 rep_sig (L _   (GenericSig nm _))     = failWithDs msg
   where msg = vcat  [ ptext (sLit "Illegal default signature for") <+> quotes (ppr nm)
                     , ptext (sLit "Default signatures are not supported by Template Haskell") ]
@@ -428,14 +428,16 @@ rep_sig (L loc (InlineSig nm ispec))  = rep_inline nm ispec loc
 rep_sig (L loc (SpecSig nm ty ispec)) = rep_specialise nm ty ispec loc
 rep_sig _                             = return []
 
-rep_proto :: Located Name -> LHsType Name -> SrcSpan 
+rep_proto :: [Located Name] -> LHsType Name -> SrcSpan
           -> DsM [(SrcSpan, Core TH.DecQ)]
-rep_proto nm ty loc 
-  = do { nm1 <- lookupLOcc nm
-       ; ty1 <- repLTy ty
-       ; sig <- repProto nm1 ty1
-       ; return [(loc, sig)]
-       }
+rep_proto nms ty loc
+  = mapM f nms
+  where
+    f nm = do { nm1 <- lookupLOcc nm
+              ; ty1 <- repLTy ty
+              ; sig <- repProto nm1 ty1
+              ; return (loc, sig)
+              }
 
 rep_inline :: Located Name 
            -> InlinePragma	-- Never defaultInlinePragma
diff --git a/compiler/hsSyn/Convert.lhs b/compiler/hsSyn/Convert.lhs
index 492f2552cd..8d79afe7fd 100644
--- a/compiler/hsSyn/Convert.lhs
+++ b/compiler/hsSyn/Convert.lhs
@@ -143,7 +143,7 @@ cvtDec (TH.FunD nm cls)
 cvtDec (TH.SigD nm typ)  
   = do  { nm' <- vNameL nm
 	; ty' <- cvtType typ
-	; returnL $ Hs.SigD (TypeSig nm' ty') }
+	; returnL $ Hs.SigD (TypeSig [nm'] ty') }
 
 cvtDec (PragmaD prag)
   = do { prag' <- cvtPragmaD prag
diff --git a/compiler/hsSyn/HsBinds.lhs b/compiler/hsSyn/HsBinds.lhs
index 5871914ad8..52ed14b9f2 100644
--- a/compiler/hsSyn/HsBinds.lhs
+++ b/compiler/hsSyn/HsBinds.lhs
@@ -252,7 +252,7 @@ getTypeSigNames :: HsValBinds a -> NameSet
 getTypeSigNames (ValBindsIn {}) 
   = panic "getTypeSigNames"
 getTypeSigNames (ValBindsOut _ sigs) 
-  = mkNameSet [unLoc n | L _ (TypeSig n _) <- sigs]
+  = mkNameSet [unLoc n | L _ (TypeSig names _) <- sigs, n <- names]
 \end{code}
 
 What AbsBinds means
@@ -595,11 +595,11 @@ type LSig name = Located (Sig name)
 data Sig name	-- Signatures and pragmas
   = 	-- An ordinary type signature
 	-- f :: Num a => a -> a
-    TypeSig (Located name) (LHsType name)
+    TypeSig [Located name] (LHsType name)
 
         -- A type signature for a default method inside a class
         -- default eq :: (Representable0 a, GEq (Rep0 a)) => a -> a -> Bool
-  | GenericSig (Located name) (LHsType name)
+  | GenericSig [Located name] (LHsType name)
 
 	-- A type signature in generated code, notably the code
 	-- generated for record selectors.  We simply record
@@ -685,18 +685,6 @@ okInstDclSig (GenericSig _ _) = False
 okInstDclSig (FixSig _)       = False
 okInstDclSig _ 	              = True
 
-sigName :: LSig name -> Maybe name
--- Used only in Haddock
-sigName (L _ sig) = sigNameNoLoc sig
-
-sigNameNoLoc :: Sig name -> Maybe name    
--- Used only in Haddock
-sigNameNoLoc (TypeSig   n _)          = Just (unLoc n)
-sigNameNoLoc (SpecSig   n _ _)        = Just (unLoc n)
-sigNameNoLoc (InlineSig n _)          = Just (unLoc n)
-sigNameNoLoc (FixSig (FixitySig n _)) = Just (unLoc n)
-sigNameNoLoc _                        = Nothing
-
 isFixityLSig :: LSig name -> Bool
 isFixityLSig (L _ (FixSig {})) = True
 isFixityLSig _	               = False
@@ -748,8 +736,8 @@ Signature equality is used when checking for duplicate signatures
 eqHsSig :: Eq a => LSig a -> LSig a -> Bool
 eqHsSig (L _ (FixSig (FixitySig n1 _))) (L _ (FixSig (FixitySig n2 _))) = unLoc n1 == unLoc n2
 eqHsSig (L _ (IdSig n1))         	(L _ (IdSig n2))                = n1 == n2
-eqHsSig (L _ (TypeSig n1 _))         	(L _ (TypeSig n2 _))            = unLoc n1 == unLoc n2
-eqHsSig (L _ (GenericSig n1 _))        	(L _ (GenericSig n2 _))         = unLoc n1 == unLoc n2
+eqHsSig (L _ (TypeSig ns1 _))         	(L _ (TypeSig ns2 _))           = map unLoc ns1 == map unLoc ns2
+eqHsSig (L _ (GenericSig ns1 _))        (L _ (GenericSig ns2 _))        = map unLoc ns1 == map unLoc ns2
 eqHsSig (L _ (InlineSig n1 _))          (L _ (InlineSig n2 _))          = unLoc n1 == unLoc n2
  	-- For specialisations, we don't have equality over
 	-- HsType, so it's not convenient to spot duplicate 
@@ -762,9 +750,9 @@ instance (OutputableBndr name) => Outputable (Sig name) where
     ppr sig = ppr_sig sig
 
 ppr_sig :: OutputableBndr name => Sig name -> SDoc
-ppr_sig (TypeSig var ty)	  = pprVarSig (unLoc var) (ppr ty)
-ppr_sig (GenericSig var ty)	  = ptext (sLit "default") <+> pprVarSig (unLoc var) (ppr ty)
-ppr_sig (IdSig id)	          = pprVarSig id (ppr (varType id))
+ppr_sig (TypeSig vars ty)	  = pprVarSig (map unLoc vars) (ppr ty)
+ppr_sig (GenericSig vars ty)	  = ptext (sLit "default") <+> pprVarSig (map unLoc vars) (ppr ty)
+ppr_sig (IdSig id)	          = pprVarSig [id] (ppr (varType id))
 ppr_sig (FixSig fix_sig) 	  = ppr fix_sig
 ppr_sig (SpecSig var ty inl) 	  = pragBrackets (pprSpec var (ppr ty) inl)
 ppr_sig (InlineSig var inl)       = pragBrackets (ppr inl <+> ppr var)
@@ -776,11 +764,13 @@ instance Outputable name => Outputable (FixitySig name) where
 pragBrackets :: SDoc -> SDoc
 pragBrackets doc = ptext (sLit "{-#") <+> doc <+> ptext (sLit "#-}") 
 
-pprVarSig :: (Outputable id) => id -> SDoc -> SDoc
-pprVarSig var pp_ty = sep [ppr var <+> dcolon, nest 2 pp_ty]
+pprVarSig :: (Outputable id) => [id] -> SDoc -> SDoc
+pprVarSig vars pp_ty = sep [pprvars <+> dcolon, nest 2 pp_ty]
+  where
+    pprvars = hsep $ punctuate comma (map ppr vars)
 
 pprSpec :: (Outputable id) => id -> SDoc -> InlinePragma -> SDoc
-pprSpec var pp_ty inl = ptext (sLit "SPECIALIZE") <+> pp_inl <+> pprVarSig var pp_ty
+pprSpec var pp_ty inl = ptext (sLit "SPECIALIZE") <+> pp_inl <+> pprVarSig [var] pp_ty
   where
     pp_inl | isDefaultInlinePragma inl = empty
            | otherwise = ppr inl
diff --git a/compiler/hsSyn/HsUtils.lhs b/compiler/hsSyn/HsUtils.lhs
index cc57e05441..6ddbd99bd4 100644
--- a/compiler/hsSyn/HsUtils.lhs
+++ b/compiler/hsSyn/HsUtils.lhs
@@ -606,7 +606,7 @@ hsTyClDeclBinders (L _ (ForeignType {tcdLName = name})) = [name]
 
 hsTyClDeclBinders (L _ (ClassDecl {tcdLName = cls_name, tcdSigs = sigs, tcdATs = ats}))
   = cls_name : 
-    concatMap hsTyClDeclBinders ats ++ [n | L _ (TypeSig n _) <- sigs]
+    concatMap hsTyClDeclBinders ats ++ [n | L _ (TypeSig ns _) <- sigs, n <- ns]
 
 hsTyClDeclBinders (L _ (TyData {tcdLName = tc_name, tcdCons = cons}))
   = tc_name : hsConDeclsBinders cons
diff --git a/compiler/parser/Parser.y.pp b/compiler/parser/Parser.y.pp
index 102f989332..25c65d10b3 100644
--- a/compiler/parser/Parser.y.pp
+++ b/compiler/parser/Parser.y.pp
@@ -1241,7 +1241,7 @@ sigdecl :: { Located (OrdList (LHsDecl RdrName)) }
                         {% do s <- checkValSig $1 $3 
                         ; return (LL $ unitOL (LL $ SigD s)) }
 	| var ',' sig_vars '::' sigtypedoc
-				{ LL $ toOL [ LL $ SigD (TypeSig n $5) | n <- $1 : unLoc $3 ] }
+				{ LL $ toOL [ LL $ SigD (TypeSig ($1 : unLoc $3) $5) ] }
 	| infix prec ops	{ LL $ toOL [ LL $ SigD (FixSig (FixitySig n (Fixity $2 (unLoc $1))))
 					     | n <- unLoc $3 ] }
 	| '{-# INLINE'   activation qvar '#-}'	      
diff --git a/compiler/parser/RdrHsSyn.lhs b/compiler/parser/RdrHsSyn.lhs
index a9433441e8..10274e1823 100644
--- a/compiler/parser/RdrHsSyn.lhs
+++ b/compiler/parser/RdrHsSyn.lhs
@@ -774,7 +774,7 @@ checkValSig
 	-> P (Sig RdrName)
 checkValSig (L l (HsVar v)) ty 
   | isUnqual v && not (isDataOcc (rdrNameOcc v))
-  = return (TypeSig (L l v) ty)
+  = return (TypeSig [L l v] ty)
 checkValSig lhs@(L l _) ty
   = parseErrorSDoc l ((text "Invalid type signature:" <+>
                        ppr lhs <+> text "::" <+> ppr ty)
diff --git a/compiler/rename/RnBinds.lhs b/compiler/rename/RnBinds.lhs
index 80a47a4ff6..3052a314fd 100644
--- a/compiler/rename/RnBinds.lhs
+++ b/compiler/rename/RnBinds.lhs
@@ -560,8 +560,9 @@ mkSigTvFn sigs
   where
     env :: NameEnv [Name]
     env = mkNameEnv [ (name, map hsLTyVarName ltvs)
-		    | L _ (TypeSig (L _ name) 
-			           (L _ (HsForAllTy Explicit ltvs _ _))) <- sigs]
+		    | L _ (TypeSig names
+			           (L _ (HsForAllTy Explicit ltvs _ _))) <- sigs
+                    , (L _ name) <- names]
 	-- Note the pattern-match on "Explicit"; we only bind
 	-- type variables from signatures with an explicit top-level for-all
 \end{code}
@@ -693,16 +694,16 @@ renameSig :: Maybe NameSet -> Sig RdrName -> RnM (Sig Name)
 -- FixitySig is renamed elsewhere.
 renameSig _ (IdSig x)
   = return (IdSig x)	  -- Actually this never occurs
-renameSig mb_names sig@(TypeSig v ty)
-  = do	{ new_v <- lookupSigOccRn mb_names sig v
-	; new_ty <- rnHsSigType (quotes (ppr v)) ty
-	; return (TypeSig new_v new_ty) }
+renameSig mb_names sig@(TypeSig vs ty)
+  = do	{ new_vs <- mapM (lookupSigOccRn mb_names sig) vs
+	; new_ty <- rnHsSigType (quotes (ppr vs)) ty
+	; return (TypeSig new_vs new_ty) }
 
-renameSig mb_names sig@(GenericSig v ty)
+renameSig mb_names sig@(GenericSig vs ty)
   = do	{ defaultSigs_on <- xoptM Opt_DefaultSignatures
         ; unless defaultSigs_on (addErr (defaultSigErr sig))
-        ; new_v <- lookupSigOccRn mb_names sig v
-	; new_ty <- rnHsSigType (quotes (ppr v)) ty
+        ; new_v <- mapM (lookupSigOccRn mb_names sig) vs
+	; new_ty <- rnHsSigType (quotes (ppr vs)) ty
 	; return (GenericSig new_v new_ty) }
 
 renameSig _ (SpecInstSig ty)
diff --git a/compiler/rename/RnNames.lhs b/compiler/rename/RnNames.lhs
index 46058c4677..4c269d904d 100644
--- a/compiler/rename/RnNames.lhs
+++ b/compiler/rename/RnNames.lhs
@@ -472,7 +472,7 @@ get_local_binders gbl_env (HsGroup {hs_valds  = ValBindsIn _ val_sigs,
     -- In a hs-boot file, the value binders come from the
     --  *signatures*, and there should be no foreign binders
     val_bndrs :: [Located RdrName]
-    val_bndrs | is_hs_boot = [nm | L _ (TypeSig nm _) <- val_sigs]
+    val_bndrs | is_hs_boot = [n | L _ (TypeSig ns _) <- val_sigs, n <- ns]
               | otherwise  = for_hs_bndrs
 
     new_simple :: Located RdrName -> RnM (GenAvailInfo Name)
diff --git a/compiler/rename/RnSource.lhs b/compiler/rename/RnSource.lhs
index 54dc378dd5..73da1f1d3e 100644
--- a/compiler/rename/RnSource.lhs
+++ b/compiler/rename/RnSource.lhs
@@ -799,7 +799,7 @@ rnTyClDecl (ClassDecl {tcdCtxt = context, tcdLName = cname,
 
 	-- Check the signatures
 	-- First process the class op sigs (op_sigs), then the fixity sigs (non_op_sigs).
-	; let sig_rdr_names_w_locs = [op | L _ (TypeSig op _) <- sigs]
+	; let sig_rdr_names_w_locs = [op | L _ (TypeSig ops _) <- sigs, op <- ops]
 	; checkDupRdrNames sig_rdr_names_w_locs
 		-- Typechecker is responsible for checking that we only
 		-- give default-method bindings for things in this class.
diff --git a/compiler/typecheck/TcBinds.lhs b/compiler/typecheck/TcBinds.lhs
index 8462403813..7e7803d69d 100644
--- a/compiler/typecheck/TcBinds.lhs
+++ b/compiler/typecheck/TcBinds.lhs
@@ -102,11 +102,12 @@ tcHsBootSigs :: HsValBinds Name -> TcM [Id]
 -- signatures in it.  The renamer checked all this
 tcHsBootSigs (ValBindsOut binds sigs)
   = do  { checkTc (null binds) badBootDeclErr
-        ; mapM (addLocM tc_boot_sig) (filter isTypeLSig sigs) }
+        ; concat <$> mapM (addLocM tc_boot_sig) (filter isTypeLSig sigs) }
   where
-    tc_boot_sig (TypeSig (L _ name) ty)
-      = do { sigma_ty <- tcHsSigType (FunSigCtxt name) ty
-           ; return (mkVanillaGlobal name sigma_ty) }
+    tc_boot_sig (TypeSig lnames ty) = mapM f lnames
+      where
+        f (L _ name) = do  { sigma_ty <- tcHsSigType (FunSigCtxt name) ty
+                           ; return (mkVanillaGlobal name sigma_ty) }
         -- Notice that we make GlobalIds, not LocalIds
     tc_boot_sig s = pprPanic "tcHsBootSigs/tc_boot_sig" (ppr s)
 tcHsBootSigs groups = pprPanic "tcHsBootSigs" (ppr groups)
@@ -177,7 +178,7 @@ tcValBinds top_lvl (ValBindsOut binds sigs) thing_inside
               ; ty_sigs = filter isTypeLSig sigs
               ; sig_fn  = mkSigFun ty_sigs }
 
-        ; poly_ids <- checkNoErrs (mapAndRecoverM tcTySig ty_sigs)
+        ; poly_ids <- concat <$> checkNoErrs (mapAndRecoverM tcTySig ty_sigs)
                 -- No recovery from bad signatures, because the type sigs
                 -- may bind type variables, so proceeding without them
                 -- can lead to a cascade of errors
@@ -1053,10 +1054,12 @@ mkSigFun :: [LSig Name] -> SigFun
 -- Precondition: no duplicates
 mkSigFun sigs = lookupNameEnv env
   where
-    env = mkNameEnv (mapCatMaybes mk_pair sigs)
-    mk_pair (L loc (TypeSig (L _ name) lhs_ty)) = Just (name, (hsExplicitTvs lhs_ty, loc))
-    mk_pair (L loc (IdSig id))                  = Just (idName id, ([], loc))
-    mk_pair _                                   = Nothing    
+    env = mkNameEnv (concatMap mk_pair sigs)
+    mk_pair (L loc (IdSig id))              = [(idName id, ([], loc))]
+    mk_pair (L loc (TypeSig lnames lhs_ty)) = map f lnames
+      where
+        f (L _ name) = (name, (hsExplicitTvs lhs_ty, loc))
+    mk_pair _                               = []
         -- The scoped names are the ones explicitly mentioned
         -- in the HsForAll.  (There may be more in sigma_ty, because
         -- of nested type synonyms.  See Note [More instantiated than scoped].)
@@ -1064,13 +1067,14 @@ mkSigFun sigs = lookupNameEnv env
 \end{code}
 
 \begin{code}
-tcTySig :: LSig Name -> TcM TcId
-tcTySig (L span (TypeSig (L _ name) ty))
-  = setSrcSpan span             $
-    do  { sigma_ty <- tcHsSigType (FunSigCtxt name) ty
-        ; return (mkLocalId name sigma_ty) }
+tcTySig :: LSig Name -> TcM [TcId]
+tcTySig (L span (TypeSig names ty))
+  = setSrcSpan span $ mapM f names
+  where
+    f (L _ name) = do  { sigma_ty <- tcHsSigType (FunSigCtxt name) ty
+                       ; return (mkLocalId name sigma_ty) }
 tcTySig (L _ (IdSig id))
-  = return id
+  = return [id]
 tcTySig s = pprPanic "tcTySig" (ppr s)
 
 -------------------
diff --git a/compiler/typecheck/TcClassDcl.lhs b/compiler/typecheck/TcClassDcl.lhs
index 8fc8a24e7a..2663895443 100644
--- a/compiler/typecheck/TcClassDcl.lhs
+++ b/compiler/typecheck/TcClassDcl.lhs
@@ -89,10 +89,10 @@ tcClassSigs :: Name	             -- Name of the class
 	    -> TcM ([TcMethInfo],    -- Exactly one for each method
                     NameEnv Type)    -- Types of the generic-default methods
 tcClassSigs clas sigs def_methods
-  = do { gen_dm_prs <- mapM (addLocM tc_gen_sig) gen_sigs
+  = do { gen_dm_prs <- concat <$> mapM (addLocM tc_gen_sig) gen_sigs
        ; let gen_dm_env = mkNameEnv gen_dm_prs
 
-       ; op_info <- mapM (addLocM (tc_sig gen_dm_env)) vanilla_sigs
+       ; op_info <- concat <$> mapM (addLocM (tc_sig gen_dm_env)) vanilla_sigs
 
        ; let op_names = mkNameSet [ n | (n,_,_) <- op_info ]
        ; sequence_ [ failWithTc (badMethodErr clas n)
@@ -110,16 +110,17 @@ tcClassSigs clas sigs def_methods
     dm_bind_names :: [Name]	-- These ones have a value binding in the class decl
     dm_bind_names = [op | L _ (FunBind {fun_id = L _ op}) <- bagToList def_methods]
 
-    tc_sig genop_env (L _ op_name, op_hs_ty)
+    tc_sig genop_env (op_names, op_hs_ty)
       = do { op_ty <- tcHsKindedType op_hs_ty	-- Class tyvars already in scope
-           ; let dm | op_name `elemNameEnv` genop_env = GenericDM
-                    | op_name `elem` dm_bind_names    = VanillaDM
-                    | otherwise                       = NoDM
-           ; return (op_name, dm, op_ty) }
+           ; return [ (op_name, f op_name, op_ty) | L _ op_name <- op_names ] }
+           where
+             f nm | nm `elemNameEnv` genop_env = GenericDM
+                  | nm `elem` dm_bind_names    = VanillaDM
+                  | otherwise                  = NoDM
 
-    tc_gen_sig (L _ op_name, gen_hs_ty)
+    tc_gen_sig (op_names, gen_hs_ty)
       = do { gen_op_ty <- tcHsKindedType gen_hs_ty
-           ; return (op_name, gen_op_ty) }
+           ; return [ (op_name, gen_op_ty) | L _ op_name <- op_names ] }
 \end{code}
 
 
diff --git a/compiler/typecheck/TcGenDeriv.lhs b/compiler/typecheck/TcGenDeriv.lhs
index ad640efec8..e4129103fe 100644
--- a/compiler/typecheck/TcGenDeriv.lhs
+++ b/compiler/typecheck/TcGenDeriv.lhs
@@ -1670,7 +1670,7 @@ fiddling around.
 genAuxBind :: SrcSpan -> DerivAuxBind -> (LHsBind RdrName, LSig RdrName)
 genAuxBind loc (GenCon2Tag tycon)
   = (mk_FunBind loc rdr_name eqns, 
-     L loc (TypeSig (L loc rdr_name) (L loc sig_ty)))
+     L loc (TypeSig [L loc rdr_name] (L loc sig_ty)))
   where
     rdr_name = con2tag_RDR tycon
 
@@ -1695,7 +1695,7 @@ genAuxBind loc (GenTag2Con tycon)
   = (mk_FunBind loc rdr_name 
 	[([nlConVarPat intDataCon_RDR [a_RDR]], 
 	   nlHsApp (nlHsVar tagToEnum_RDR) a_Expr)],
-     L loc (TypeSig (L loc rdr_name) (L loc sig_ty)))
+     L loc (TypeSig [L loc rdr_name] (L loc sig_ty)))
   where
     sig_ty = HsCoreTy $ mkForAllTys (tyConTyVars tycon) $
              intTy `mkFunTy` mkParentType tycon
@@ -1704,7 +1704,7 @@ genAuxBind loc (GenTag2Con tycon)
 
 genAuxBind loc (GenMaxTag tycon)
   = (mkHsVarBind loc rdr_name rhs,
-     L loc (TypeSig (L loc rdr_name) (L loc sig_ty)))
+     L loc (TypeSig [L loc rdr_name] (L loc sig_ty)))
   where
     rdr_name = maxtag_RDR tycon
     sig_ty = HsCoreTy intTy
@@ -1714,7 +1714,7 @@ genAuxBind loc (GenMaxTag tycon)
 
 genAuxBind loc (MkTyCon tycon)	--  $dT
   = (mkHsVarBind loc rdr_name rhs,
-     L loc (TypeSig (L loc rdr_name) sig_ty))
+     L loc (TypeSig [L loc rdr_name] sig_ty))
   where
     rdr_name = mk_data_type_name tycon
     sig_ty   = nlHsTyVar dataType_RDR
@@ -1725,7 +1725,7 @@ genAuxBind loc (MkTyCon tycon)	--  $dT
 
 genAuxBind loc (MkDataCon dc)	--  $cT1 etc
   = (mkHsVarBind loc rdr_name rhs,
-     L loc (TypeSig (L loc rdr_name) sig_ty))
+     L loc (TypeSig [L loc rdr_name] sig_ty))
   where
     rdr_name = mk_constr_name dc
     sig_ty   = nlHsTyVar constr_RDR