[add front end support for existential types
John Meacham <john@repetae.net>**20060213074638] hunk ./FrontEnd/DataConsAssump.hs 87
-conDeclType modName kt preds tResult (HsConDecl _sloc conName bangTypes)
+conDeclType modName kt preds tResult (HsConDecl { hsConDeclName = conName, hsConDeclConArg = bangTypes })
hunk ./FrontEnd/DataConsAssump.hs 92
-conDeclType modName kt preds tResult rd@(HsRecDecl _sloc conName _)
+conDeclType modName kt preds tResult rd@HsRecDecl { hsConDeclName = conName }
hunk ./FrontEnd/Desugar.hs 266
-    ds' = [ (c,[(n,t) | (ns,t) <- rs , n <- ns ]) | HsRecDecl _ c rs <- ds ]
+    ds' = [ (c,[(n,t) | (ns,t) <- rs , n <- ns ]) | HsRecDecl { hsConDeclName = c, hsConDeclRecArg = rs } <- ds ]
hunk ./FrontEnd/HsParser.ly 121
+>	'exists'	{ KW_Exists }
hunk ./FrontEnd/HsParser.ly 354
+>       | 'exists' tbinds '.' ctype     { HsTyExists { hsTypeVars = reverse $2, hsTypeType = $4 } }
hunk ./FrontEnd/HsParser.ly 425
->	: srcloc scontype		{ HsConDecl $1 (fst $2) (snd $2) }
->	| srcloc sbtype conop sbtype	{ HsConDecl $1 $3 [$2,$4] }
->	| srcloc con '{' fielddecls '}'
->					{ HsRecDecl $1 $2 (reverse $4) }
+>	: srcloc mexists scontype		{ HsConDecl { hsConDeclSrcLoc = $1, hsConDeclName = (fst $3), hsConDeclConArg = (snd $3), hsConDeclExists = $2 } }
+>	| srcloc mexists sbtype conop sbtype	{ HsConDecl { hsConDeclSrcLoc = $1, hsConDeclName = $4, hsConDeclConArg = [$3,$5], hsConDeclExists = $2 } }
+>	| srcloc mexists con '{' fielddecls '}'
+>					{ HsRecDecl { hsConDeclSrcLoc = $1, hsConDeclName = $3, hsConDeclRecArg = (reverse $5), hsConDeclExists = $2 } }
+
+> mexists :: { [HsTyVarBind] }
+>         : 'exists' tbinds '.'         { $2 }
+>         |                             { [] }
hunk ./FrontEnd/HsPretty.hs 345
-ppHsConstr (HsRecDecl pos name fieldList) =
+ppHsConstr (HsRecDecl { hsConDeclName = name, hsConDeclRecArg = fieldList }) =
hunk ./FrontEnd/HsPretty.hs 348
-ppHsConstr (HsConDecl pos name typeList)
+ppHsConstr (HsConDecl { hsConDeclName = name, hsConDeclConArg = typeList})
hunk ./FrontEnd/HsSyn.hs 168
-	 = HsConDecl { hsConDeclSrcLoc :: SrcLoc, hsConDeclName :: HsName, hsConDeclConArg :: [HsBangType] }
-	 | HsRecDecl { hsConDeclSrcLoc :: SrcLoc, hsConDeclName :: HsName, hsConDeclRecArg :: [([HsName],HsBangType)] }
+	 = HsConDecl { hsConDeclSrcLoc :: SrcLoc, hsConDeclExists :: [HsTyVarBind], hsConDeclName :: HsName, hsConDeclConArg :: [HsBangType] }
+	 | HsRecDecl { hsConDeclSrcLoc :: SrcLoc, hsConDeclExists :: [HsTyVarBind], hsConDeclName :: HsName, hsConDeclRecArg :: [([HsName],HsBangType)] }
hunk ./FrontEnd/HsSyn.hs 171
-  {-! derive: is !-}
+  {-! derive: is, update !-}
hunk ./FrontEnd/HsSyn.hs 208
+         | HsTyExists {
+            hsTypeVars :: [HsTyVarBind],
+            hsTypeType :: HsQualType }
hunk ./FrontEnd/HsSyn.hs 212
-  {-! derive: GhcBinary !-}
+  {-! derive: GhcBinary, is !-}
hunk ./FrontEnd/HsSyn.hs 219
-  {-! derive: GhcBinary !-}
+  {-! derive: GhcBinary, update !-}
hunk ./FrontEnd/Lexer.hs 108
+        | KW_Exists
hunk ./FrontEnd/Lexer.hs 166
+ ( "exists",    KW_Exists ),
hunk ./FrontEnd/Rename.hs 458
-renameHsConDecl (HsConDecl srcLoc hsName hsBangTypes) subTable = do
+renameHsConDecl cd@(HsConDecl { hsConDeclSrcLoc = srcLoc, hsConDeclName = hsName, hsConDeclConArg = hsBangTypes }) subTable = do
hunk ./FrontEnd/Rename.hs 461
-    hsBangTypes' <- renameHsBangTypes hsBangTypes subTable
-    return (HsConDecl srcLoc hsName' hsBangTypes')
-renameHsConDecl (HsRecDecl srcLoc hsName stuff) subTable = do
+    subTable' <- updateSubTableWithHsNames subTable (map hsTyVarBindName (hsConDeclExists cd))
+    es <- renameAny (hsConDeclExists cd) subTable'
+    hsBangTypes' <- renameHsBangTypes hsBangTypes subTable'
+    return cd { hsConDeclName = hsName', hsConDeclConArg = hsBangTypes', hsConDeclExists = es }
+renameHsConDecl cd@HsRecDecl { hsConDeclSrcLoc = srcLoc, hsConDeclName = hsName, hsConDeclRecArg = stuff} subTable = do
hunk ./FrontEnd/Rename.hs 468
-    stuff' <- sequence [ do ns' <- mapRename renameHsName ns subTable; t' <- renameHsBangType t subTable; return (ns',t')  |  (ns,t) <- stuff]
-    return (HsRecDecl srcLoc hsName' stuff')
+    subTable' <- updateSubTableWithHsNames subTable (map hsTyVarBindName (hsConDeclExists cd))
+    es <- renameAny (hsConDeclExists cd) subTable'
+    stuff' <- sequence [ do ns' <- mapRename renameHsName ns subTable'; t' <- renameHsBangType t subTable; return (ns',t')  |  (ns,t) <- stuff]
+    return cd { hsConDeclName = hsName', hsConDeclRecArg = stuff', hsConDeclExists = es }
hunk ./FrontEnd/Rename.hs 515
+    rt (HsTyExists ts v) subTable  = do
+        -- False <- return dovar
+        subTable' <- updateSubTableWithHsNames subTable (map hsTyVarBindName ts)
+        ts' <- renameAny ts subTable'
+        v' <- renameHsQualType v subTable'
+        return $ HsTyExists ts' v'
hunk ./FrontEnd/Rename.hs 1500
-    replaceName f object
-      = let a # b = a $ (replaceName f b)
-        in case object of
-            HsConDecl  srcloc name bangtyps ->
-                HsConDecl  # srcloc # name # bangtyps
-            HsRecDecl  srcloc name names_and_bangtyp ->
-                HsRecDecl  # srcloc # name # names_and_bangtyp
+    replaceName f = hsConDeclExists_u (replaceName f) . hsConDeclName_u (replaceName f) . hsConDeclRecArg_u (replaceName f) . hsConDeclConArg_u (replaceName f)
+--    replaceName f object
+--      = let a # b = a $ (replaceName f b)
+--        in case object of
+--            HsConDecl  srcloc name bangtyps ->
+--                HsConDecl  # srcloc # name # bangtyps
+--            HsRecDecl  srcloc name names_and_bangtyp ->
+--                HsRecDecl  # srcloc # name # names_and_bangtyp
hunk ./FrontEnd/Rename.hs 1692
+instance Renameable HsTyVarBind where
+    replaceName f = hsTyVarBindName_u (replaceName f)
hunk ./FrontEnd/TypeSyns.hs 176
-renameHsConDecl (HsConDecl srcLoc hsName hsBangTypes) subTable = do
+renameHsConDecl cd@(HsConDecl { hsConDeclSrcLoc = srcLoc, hsConDeclName = hsName, hsConDeclConArg = hsBangTypes }) subTable = do
hunk ./FrontEnd/TypeSyns.hs 180
-    return (HsConDecl srcLoc hsName' hsBangTypes')
-renameHsConDecl (HsRecDecl srcLoc hsName stuff) subTable = do
+    return cd { hsConDeclName = hsName', hsConDeclConArg = hsBangTypes' }
+renameHsConDecl cd@HsRecDecl { hsConDeclSrcLoc = srcLoc, hsConDeclName = hsName, hsConDeclRecArg = stuff} subTable = do
hunk ./FrontEnd/TypeSyns.hs 185
-    return (HsRecDecl srcLoc hsName' stuff')
+    return cd { hsConDeclName = hsName', hsConDeclRecArg = stuff' }
hunk ./FrontEnd/TypeSyns.hs 221
-        -- False <- return dovar
hunk ./FrontEnd/TypeSyns.hs 223
+    rt (HsTyExists ts v) subTable  = do
+        v <- renameHsQualType v subTable
+        return $ HsTyExists ts v
hunk ./FrontEnd/TypeSyns.hs 785
+instance Renameable HsTyVarBind where
+    replaceName f = hsTyVarBindName_u (replaceName f)
hunk ./FrontEnd/TypeSyns.hs 824
-    replaceName f object
-      = let a # b = a $ (replaceName f b)
-        in case object of
-            HsConDecl  srcloc name bangtyps ->
-                HsConDecl  # srcloc # name # bangtyps
-            HsRecDecl  srcloc name names_and_bangtyp ->
-                HsRecDecl  # srcloc # name # names_and_bangtyp
+    replaceName f = hsConDeclExists_u (replaceName f) . hsConDeclName_u (replaceName f) . hsConDeclRecArg_u (replaceName f) . hsConDeclConArg_u (replaceName f)
+--      let a # b = a $ (replaceName f b)
+--        in case object of
+--            HsConDecl  srcloc name bangtyps ->
+--                HsConDecl  # srcloc # name # bangtyps
+--            HsRecDecl  srcloc name names_and_bangtyp ->
+--                HsRecDecl  # srcloc # name # names_and_bangtyp