[make type synonym declarations take types as arguments, rather than just variables. for use in type synonym instances
John Meacham <john@repetae.net>**20061024011934] hunk ./FrontEnd/Class.hs 14
-    makeInstanceEnvironment,
+    --makeInstanceEnvironment,
hunk ./FrontEnd/Class.hs 62
-    instAssocs :: [(Tycon,[Tyvar],Sigma)]  -- only has extra arguments, after first one
+    instAssocs :: [(Tycon,[Tyvar],[Tyvar],Sigma)]
hunk ./FrontEnd/Class.hs 68
-    pprint Inst { instHead = h, instAssocs = as } = pprint h <+> text "where" <$> vcat [ text "    type" <+> pprint n <+> text "_" <+> hsep (map pprint ts) <+> text "=" <+> pprint sigma  | (n,ts,sigma) <- as]
+    pprint Inst { instHead = h, instAssocs = as } = pprint h <+> text "where" <$> vcat [ text "    type" <+> pprint n <+> text "_" <+> hsep (map pprint ts) <+> text "=" <+> pprint sigma  | (n,_,ts,sigma) <- as]
hunk ./FrontEnd/Class.hs 110
-newtype InstanceEnv = InstanceEnv { instanceEnv :: Map.Map (Name,Name) (Tyvar,[Tyvar],Type) }
+newtype InstanceEnv = InstanceEnv { instanceEnv :: Map.Map (Name,Name) ([Tyvar],[Tyvar],Type) }
hunk ./FrontEnd/Class.hs 116
-        ans = [ ((tyconName tc,tyconName ca),(vv,rs,e)) | (tc,rs,e) <- as]
+        ans = [ ((tyconName tc,tyconName ca),(is,rs,e)) | (tc,is,rs,e) <- as]
hunk ./FrontEnd/Class.hs 119
+{-
hunk ./FrontEnd/Class.hs 126
+-}
hunk ./FrontEnd/Class.hs 235
-   assocs = [ (tc,rs,s) | (tc,~(_:rs),~(Just s)) <- createClassAssocs kt decls ]
+   assocs = [ (tc,[r],rs,s) | (tc,~(r:rs),~(Just s)) <- createClassAssocs kt decls ]
hunk ./FrontEnd/Class.hs 338
-createClassAssocs kt decls = [ (ctc n,map ct as,ctype t)| HsTypeDecl { hsDeclName = n, hsDeclArgs = as, hsDeclType = t } <- decls ] where
+createClassAssocs kt decls = [ (ctc n,map ct as,ctype t)| HsTypeDecl { hsDeclName = n, hsDeclTArgs = as, hsDeclType = t } <- decls ] where
hunk ./FrontEnd/Class.hs 340
-    ct n = let nn = toName TypeVal n in tyvar nn (kindOf nn kt)
+    ct (HsTyVar n) = let nn = toName TypeVal n in tyvar nn (kindOf nn kt)
hunk ./FrontEnd/HsErrors.hs 5
-module FrontEnd.HsErrors where
+module FrontEnd.HsErrors(hsType,hsDecl,checkDeriving) where
hunk ./FrontEnd/HsErrors.hs 8
+import FrontEnd.SrcLoc
+import FrontEnd.Syn.Traverse
hunk ./FrontEnd/HsErrors.hs 16
-import FrontEnd.Syn.Traverse
hunk ./FrontEnd/HsErrors.hs 32
+data Context = InClass | InInstance | TopLevel
+    deriving(Eq)
+
+instance Show Context where
+    show InClass = "in a class declaration"
+    show InInstance = "in an instance declaration"
+    show TopLevel = "at the top level"
+
hunk ./FrontEnd/HsErrors.hs 42
-hsDecl HsDataDecl { hsDeclSrcLoc = sl, hsDeclCons = cs, hsDeclDerives = ds' } = do
-    let ds = map (toName ClassName) ds'
-    when (null cs) $ warn sl "h98-emptydata" "data types with no constructors are a non-haskell98 feature"
-    checkDeriving sl False ds
-    let isEnum = all (\x ->  null (hsConDeclArgs x)) cs
-    when (not isEnum && class_Enum `elem` ds) $ warn sl "derive-enum" "Cannot derive enum from non enumeration type"
-    when (not isEnum && length cs /= 1 && class_Bounded `elem` ds) $ warn sl "derive-bounded" "Cannot derive bounded from non enumeration or unary type"
-    return ()
-hsDecl HsNewTypeDecl { hsDeclSrcLoc = sl, hsDeclDerives = ds' } = do
-    let ds = map (toName ClassName) ds'
-    checkDeriving sl True ds
-    return ()
-hsDecl _ = return ()
+hsDecl decl = f TopLevel decl where
+    f TopLevel HsDataDecl { hsDeclSrcLoc = sl, hsDeclCons = cs, hsDeclDerives = ds' } = do
+        let ds = map (toName ClassName) ds'
+        when (null cs) $ warn sl "h98-emptydata" "data types with no constructors are a non-haskell98 feature"
+        checkDeriving sl False ds
+        let isEnum = all (\x ->  null (hsConDeclArgs x)) cs
+        when (not isEnum && class_Enum `elem` ds) $ warn sl "derive-enum" "Cannot derive enum from non enumeration type"
+        when (not isEnum && length cs /= 1 && class_Bounded `elem` ds) $ warn sl "derive-bounded" "Cannot derive bounded from non enumeration or unary type"
+        return ()
+    f TopLevel HsNewTypeDecl { hsDeclSrcLoc = sl, hsDeclDerives = ds' } = do
+        let ds = map (toName ClassName) ds'
+        checkDeriving sl True ds
+        return ()
+    f context decl@HsTypeDecl { hsDeclTArgs = as }
+        | context `elem` [TopLevel, InClass], any (not . isHsTyVar) as = warn (srcLoc decl) "invalid-decl" $ "complex type arguments not allowed " ++ show context
+    f context decl@HsDataDecl {} = warn (srcLoc decl) "invalid-decl" $ "data declaration not allowed " ++ show context
+    f context decl@HsNewTypeDecl {} = warn (srcLoc decl) "invalid-decl" $ "newtype declaration not allowed " ++ show context
+    f TopLevel decl@HsClassDecl {} = return ()
+    f TopLevel decl@HsInstDecl {} = return ()
+    f context decl@HsClassDecl {} = warn (srcLoc decl) "invalid-decl" $ "class declaration not allowed " ++ show context
+    f context decl@HsInstDecl {} = warn (srcLoc decl) "invalid-decl" $ "instance declaration not allowed " ++ show context
+
+    f _ _ = return ()
hunk ./FrontEnd/HsErrors.hs 68
-checkDerining sl True _ = warn sl "h98-newtypederiv" "arbitrary newtype derivations are a non-haskell98 feature"
-checkDerining sl False _ = warn sl "unknown-deriving" "attempt to derive from a non-derivable class"
+checkDeriving sl True _ = warn sl "h98-newtypederiv" "arbitrary newtype derivations are a non-haskell98 feature"
+checkDeriving sl False _ = warn sl "unknown-deriving" "attempt to derive from a non-derivable class"
hunk ./FrontEnd/HsParser.ly 444
-> simpletype :: { (HsName, [HsName]) }
->	: tycon tyvars			{ ($1,reverse $2) }
+> simpletype :: { (HsName, [HsType]) }
+>	: tycon atypes			{ ($1,reverse $2) }
hunk ./FrontEnd/HsParser.ly 447
-> tyvars :: { [HsName] }
->	: tyvars tyvar			{ $2 : $1 }
+> atypes :: { [HsType] }
+>	: atypes atype			{ $2 : $1 }
hunk ./FrontEnd/HsPretty.hs 280
-		   ++ map ppHsName nameList
+		   ++ map ppHsType nameList
hunk ./FrontEnd/HsSyn.hs 146
-	 = HsTypeDecl	 { hsDeclSrcLoc :: SrcLoc, hsDeclName :: HsName, hsDeclArgs :: [HsName], hsDeclType :: HsType }
+	 = HsTypeDecl	 { hsDeclSrcLoc :: SrcLoc, hsDeclName :: HsName, hsDeclTArgs :: [HsType], hsDeclType :: HsType }
hunk ./FrontEnd/KindInfer.hs 259
-kiTyConDecl :: DataDeclHead -> KI ()
+kiTyConDecl :: (HsName,[HsName]) -> KI ()
hunk ./FrontEnd/KindInfer.hs 430
-type DataDeclHead = (HsName, [HsName])
+--type DataDeclHead = (HsName, [HsName])
hunk ./FrontEnd/KindInfer.hs 436
-     kgDataDecls ::[DataDeclHead],
+     kgDataDecls ::[(HsName, [HsName])],
hunk ./FrontEnd/KindInfer.hs 453
-        tell mempty { kgDataDecls = [(name,names)] }
+        tell mempty { kgDataDecls = [(name,[ n | ~(HsTyVar n) <- names])] }
hunk ./FrontEnd/KindInfer.hs 456
-            newAssocs = [ (name,names,t,map HsTyVar names) | HsTypeDecl _sloc name names t <- sigsAndDefaults ]
+            newAssocs = [ (name,[ n | ~(HsTyVar n) <- names],t,names) | HsTypeDecl _sloc name names t <- sigsAndDefaults ]
hunk ./FrontEnd/Rename.hs 75
+import qualified Data.Set as Set
+
hunk ./FrontEnd/Rename.hs 80
+import FrontEnd.HsErrors as HsErrors
hunk ./FrontEnd/Rename.hs 82
+import FrontEnd.Syn.Traverse
hunk ./FrontEnd/Rename.hs 85
-import FrontEnd.HsErrors as HsErrors
hunk ./FrontEnd/Rename.hs 88
-import qualified Name.VConsts as V
+import Support.FreeVars
hunk ./FrontEnd/Rename.hs 91
-import Util.UniqueMonad
hunk ./FrontEnd/Rename.hs 92
-import FrontEnd.Syn.Traverse
+import Util.UniqueMonad
hunk ./FrontEnd/Rename.hs 94
-
+import qualified Name.VConsts as V
hunk ./FrontEnd/Rename.hs 326
-    subTable' <- updateSubTableWithHsNames subTable hsNames
+    subTable' <- updateSubTableWithHsNames subTable (Set.toList $ freeVars hsNames)
hunk ./FrontEnd/Rename.hs 328
-    hsNames' <- renameHsNames hsNames subTable'
+    hsNames' <- renameAny hsNames subTable'
hunk ./FrontEnd/Syn/Traverse.hs 3
+import qualified Data.Set as Set
+import Control.Monad.Writer
+
hunk ./FrontEnd/Syn/Traverse.hs 9
+import Support.FreeVars
+
+
+instance FreeVars HsType (Set.Set HsName) where
+    freeVars t = execWriter (f t) where
+        f (HsTyVar v) = tell (Set.singleton v)
+        f t = traverseHsType_ f t
hunk ./FrontEnd/TypeSynonyms.hs 41
-    [ (toName TypeConstructor name,( args , quantifyHsType args (HsQualType [] t) , sl)) | (HsTypeDecl sl name args t) <- ts]
-    ++  [ (toName TypeConstructor name,( args , HsTyAssoc, sl)) | (HsClassDecl _ _ ds) <- ts,(HsTypeDecl sl name args _) <- ds]
+    [ (toName TypeConstructor name,( args , quantifyHsType args (HsQualType [] t) , sl)) | (HsTypeDecl sl name args' t) <- ts, let args = [ n | ~(HsTyVar n) <- args'] ]
+     ++ [ (toName TypeConstructor name,( args , HsTyAssoc, sl)) | (HsClassDecl _ _ ds) <- ts,(HsTypeDecl sl name args' _) <- ds, let args = [ n | ~(HsTyVar n) <- args'] ]
hunk ./FrontEnd/Warning.hs 75
-fatal = ["undefined-name", "ambiguous-name", "multiply-defined",
-    "ambiguous-export", "unknown-import", "parse-error", "missing-dep", "type-synonym-partialap" ]
+fatal = [
+    "undefined-name",
+    "ambiguous-name",
+    "multiply-defined",
+    "ambiguous-export",
+    "unknown-import",
+    "parse-error",
+    "missing-dep",
+    "invalid-decl",
+    "type-synonym-partialap" ]
+