- (cvt_context ctxt, tconName tc, cvt_tvs tvs)
- (DataCons (map mk_con constrs))
- (mk_derivs derivs) loc0)
- where
- mk_con (Constr c strtys)
- = ConDecl (cName c) noExistentials noContext
- (PrefixCon (map mk_arg strtys)) loc0
- mk_con (RecConstr c varstrtys)
- = ConDecl (cName c) noExistentials noContext
- (Hs.RecCon (map mk_id_arg varstrtys)) loc0
- mk_con (InfixConstr st1 c st2)
- = ConDecl (cName c) noExistentials noContext
- (InfixCon (mk_arg st1) (mk_arg st2)) loc0
-
- mk_arg (Strict, ty) = BangType MarkedUserStrict (cvtType ty)
- mk_arg (NonStrict, ty) = BangType NotMarkedStrict (cvtType ty)
-
- mk_id_arg (i, Strict, ty)
- = (vName i, BangType MarkedUserStrict (cvtType ty))
- mk_id_arg (i, NonStrict, ty)
- = (vName i, BangType NotMarkedStrict (cvtType ty))
-
- mk_derivs [] = Nothing
- mk_derivs cs = Just [HsClassP (tconName c) [] | c <- cs]
-
-cvt_top (Class ctxt cl tvs decs)
- = Left $ TyClD (mkClassDecl (cvt_context ctxt, tconName cl, cvt_tvs tvs)
- noFunDeps
- sigs (Just binds) loc0)
+ (cvt_context ctxt, noLoc (tconName tc), cvt_tvs tvs)
+ (map mk_con constrs)
+ (mk_derivs derivs))
+
+cvt_top (NewtypeD ctxt tc tvs constr derivs)
+ = Left $ TyClD (mkTyData NewType
+ (cvt_context ctxt, noLoc (tconName tc), cvt_tvs tvs)
+ [mk_con constr]
+ (mk_derivs derivs))
+
+cvt_top (ClassD ctxt cl tvs decs)
+ = Left $ TyClD (mkClassDecl (cvt_context ctxt, noLoc (tconName cl), cvt_tvs tvs)
+ noFunDeps sigs
+ binds)