From 044805225a08d5e370b72d2efed66880912b0806 Mon Sep 17 00:00:00 2001 From: Tim Chevalier Date: Sun, 4 May 2008 23:02:33 +0000 Subject: [PATCH] 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! --- compiler/coreSyn/ExternalCore.lhs | 2 +- compiler/coreSyn/MkExternalCore.lhs | 4 +--- compiler/coreSyn/PprExternalCore.lhs | 5 +---- 3 files changed, 3 insertions(+), 8 deletions(-) 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) = -- 1.7.10.4