From: Tim Chevalier Date: Sun, 4 May 2008 23:02:33 +0000 (+0000) Subject: Improve External Core newtype syntax X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=044805225a08d5e370b72d2efed66880912b0806;hp=650a23c61c6da4666a4cabd7ec5cca65eacd9db8 Improve External Core newtype syntax I realized that recursive newtypes no longer have to be distinguished in the External Core AST, because explicit coercions allow the typechecker to typecheck newtypes without ever expanding newtypes. So, now all newtypes in External Core have a representation clause. O frabjous day! --- diff --git a/compiler/coreSyn/ExternalCore.lhs b/compiler/coreSyn/ExternalCore.lhs index d8eaa3c..07a1dfb 100644 --- a/compiler/coreSyn/ExternalCore.lhs +++ b/compiler/coreSyn/ExternalCore.lhs @@ -10,7 +10,7 @@ data Module data Tdef = Data (Qual Tcon) [Tbind] [Cdef] - | Newtype (Qual Tcon) (Qual Tcon) [Tbind] (Maybe Ty) + | Newtype (Qual Tcon) (Qual Tcon) [Tbind] Ty data Cdef = Constr (Qual Dcon) [Tbind] [Ty] diff --git a/compiler/coreSyn/MkExternalCore.lhs b/compiler/coreSyn/MkExternalCore.lhs index 861f501..34f39a5 100644 --- a/compiler/coreSyn/MkExternalCore.lhs +++ b/compiler/coreSyn/MkExternalCore.lhs @@ -90,12 +90,10 @@ collect_tdefs tcon tdefs Nothing -> pprPanic ("MkExternalCore: newtype tcon\ should have a coercion: ") (ppr tcon)) (map make_tbind tyvars) - repclause + (make_ty (snd (newTyConRhs tcon))) | otherwise = C.Data (qtc tcon) (map make_tbind tyvars) (map make_cdef (tyConDataCons tcon)) - where repclause | isRecursiveTyCon tcon || isOpenTyCon tcon= Nothing - | otherwise = Just (make_ty (snd (newTyConRhs tcon))) tyvars = tyConTyVars tcon collect_tdefs _ tdefs = tdefs diff --git a/compiler/coreSyn/PprExternalCore.lhs b/compiler/coreSyn/PprExternalCore.lhs index 25394e2..76ef6da 100644 --- a/compiler/coreSyn/PprExternalCore.lhs +++ b/compiler/coreSyn/PprExternalCore.lhs @@ -56,10 +56,7 @@ ptdef (Data tcon tbinds cdefs) = ptdef (Newtype tcon coercion tbinds rep) = text "%newtype" <+> pqname tcon <+> pqname coercion <+> (hsep (map ptbind tbinds)) $$ indent repclause - where repclause = case rep of - Just ty -> char '=' <+> pty ty - Nothing -> empty - + where repclause = char '=' <+> pty rep pcdef :: Cdef -> Doc pcdef (Constr dcon tbinds tys) =