X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcGenDeriv.lhs;h=9826f2f88193363eb28392e333bd3d399dd03dc8;hp=0eabe327b6468e47e210a30efc2ee76fa417b690;hb=6b1a6f305f801a1e2a90c3b513e76e7c2d221499;hpb=2896564599896f78bddf881e70165b1b299a815c diff --git a/compiler/typecheck/TcGenDeriv.lhs b/compiler/typecheck/TcGenDeriv.lhs index 0eabe32..9826f2f 100644 --- a/compiler/typecheck/TcGenDeriv.lhs +++ b/compiler/typecheck/TcGenDeriv.lhs @@ -688,9 +688,7 @@ gen_Ix_binds loc tycon data_con = case tyConSingleDataCon_maybe tycon of -- just checking... Nothing -> panic "get_Ix_binds" - Just dc | any isUnLiftedType (dataConOrigArgTys dc) - -> pprPanic "Can't derive Ix for a single-constructor type with primitive argument types:" (ppr tycon) - | otherwise -> dc + Just dc -> dc con_arity = dataConSourceArity data_con data_con_RDR = getRdrName data_con @@ -898,9 +896,8 @@ gen_Read_binds get_fixity loc tycon data_con_str con = occNameString (getOccName con) read_punc c = bindLex (punc_pat c) - read_arg a ty - | isUnLiftedType ty = pprPanic "Error in deriving:" (text "Can't read unlifted types yet:" <+> ppr ty) - | otherwise = noLoc (mkBindStmt (nlVarPat a) (nlHsVarApps step_RDR [readPrec_RDR])) + read_arg a ty = ASSERT( not (isUnLiftedType ty) ) + noLoc (mkBindStmt (nlVarPat a) (nlHsVarApps step_RDR [readPrec_RDR])) read_field lbl a = read_lbl lbl ++ [read_punc "=",