| 1 | instance Typeable a => Data (Expr a) where |
|---|
| 2 | gfoldl _ z (Var v) = z (Var v) |
|---|
| 3 | gfoldl _ z (Lit l) = z (Lit l) |
|---|
| 4 | gfoldl k z (App e1 e2) = z App `k` e1 `k` e2 |
|---|
| 5 | gfoldl k z (Lam b e) = z (Lam b) `k` e |
|---|
| 6 | gfoldl k z (Let bs e) = z Let `k` bs `k` e |
|---|
| 7 | gfoldl k z (Case e b t alts) = z (\e' alts' -> Case e' b t (map unwrapAlt alts')) `k` e `k` (map WrappedAlt alts) |
|---|
| 8 | gfoldl k z (Cast e o) = z (\e' -> Cast e' o) `k` e |
|---|
| 9 | gfoldl k z (Note n e) = z (Note n) `k` e |
|---|
| 10 | gfoldl _ z (Type t) = z (Type t) |
|---|
| 11 | |
|---|
| 12 | gunfold _ _ _ = error "gunfold not defined for Expr" |
|---|
| 13 | |
|---|
| 14 | toConstr (Var _) = con_Var |
|---|
| 15 | toConstr (Lit _) = con_Lit |
|---|
| 16 | toConstr (App _ _) = con_App |
|---|
| 17 | toConstr (Lam _ _) = con_Lam |
|---|
| 18 | toConstr (Let _ _) = con_Let |
|---|
| 19 | toConstr (Case _ _ _ _) = con_Case |
|---|
| 20 | toConstr (Cast _ _) = con_Cast |
|---|
| 21 | toConstr (Note _ _) = con_Note |
|---|
| 22 | toConstr (Type _) = con_Type |
|---|
| 23 | |
|---|
| 24 | dataTypeOf _ = ty_Expr |
|---|
| 25 | |
|---|
| 26 | con_Var, con_Lit, con_App, con_Lam, con_Let, con_Case, con_Cast, con_Note, con_Type :: Constr |
|---|
| 27 | con_Var = mkConstr ty_Expr "Var" [] Prefix |
|---|
| 28 | con_Lit = mkConstr ty_Expr "Lit" [] Prefix |
|---|
| 29 | con_App = mkConstr ty_Expr "App" [] Prefix |
|---|
| 30 | con_Lam = mkConstr ty_Expr "Lam" [] Prefix |
|---|
| 31 | con_Let = mkConstr ty_Expr "Let" [] Prefix |
|---|
| 32 | con_Case = mkConstr ty_Expr "Case" [] Prefix |
|---|
| 33 | con_Cast = mkConstr ty_Expr "Cast" [] Prefix |
|---|
| 34 | con_Note = mkConstr ty_Expr "Note" [] Prefix |
|---|
| 35 | con_Type = mkConstr ty_Expr "Type" [] Prefix |
|---|
| 36 | |
|---|
| 37 | ty_Expr :: DataType |
|---|
| 38 | ty_Expr = mkDataType "CoreSyn.Expr" [con_Var, con_Lit, con_App, con_Lam, con_Let, con_Case, con_Cast, con_Note, con_Type] |
|---|
| 39 | |
|---|
| 40 | |
|---|
| 41 | instance Typeable a => Data (Bind a) where |
|---|
| 42 | gfoldl k z (NonRec b e) = z (NonRec b) `k` e |
|---|
| 43 | gfoldl k z (Rec bed_es) = let (bs, es) = unzip bed_es |
|---|
| 44 | in z (\es' -> Rec (zip bs es')) `k` es |
|---|
| 45 | |
|---|
| 46 | gunfold _ _ _ = error "gunfold not defined for Bind" |
|---|
| 47 | |
|---|
| 48 | toConstr (NonRec _ _) = con_NonRec |
|---|
| 49 | toConstr (Rec _) = con_Rec |
|---|
| 50 | |
|---|
| 51 | dataTypeOf _ = ty_Bind |
|---|
| 52 | |
|---|
| 53 | con_NonRec, con_Rec :: Constr |
|---|
| 54 | con_NonRec = mkConstr ty_Bind "NonRec" [] Prefix |
|---|
| 55 | con_Rec = mkConstr ty_Bind "Rec" [] Prefix |
|---|
| 56 | |
|---|
| 57 | ty_Bind :: DataType |
|---|
| 58 | ty_Bind = mkDataType "CoreSyn.Bind" [con_NonRec, con_Rec] |
|---|
| 59 | |
|---|
| 60 | |
|---|
| 61 | newtype WrappedAlt a = WrappedAlt (Alt a) |
|---|
| 62 | |
|---|
| 63 | unwrapAlt :: WrappedAlt a -> Alt a |
|---|
| 64 | unwrapAlt (WrappedAlt x) = x |
|---|
| 65 | |
|---|
| 66 | instance Typeable a => Typeable (WrappedAlt a) where |
|---|
| 67 | -- Hack or not? I'm not sure! |
|---|
| 68 | typeOf = typeOf . unwrapAlt |
|---|
| 69 | |
|---|
| 70 | instance Typeable a => Data (WrappedAlt a) where |
|---|
| 71 | gfoldl k z (WrappedAlt (con, bs, e)) = z (\e' -> WrappedAlt (con, bs, e')) `k` e |
|---|
| 72 | |
|---|
| 73 | gunfold _ _ _ = error "gunfold not defined for Alt" |
|---|
| 74 | |
|---|
| 75 | toConstr _ = con_Alt |
|---|
| 76 | |
|---|
| 77 | dataTypeOf _ = ty_Alt |
|---|
| 78 | |
|---|
| 79 | con_Alt :: Constr |
|---|
| 80 | con_Alt = mkConstr ty_Alt "Alt" [] Prefix |
|---|
| 81 | |
|---|
| 82 | ty_Alt :: DataType |
|---|
| 83 | ty_Alt = mkDataType "CoreSyn.Alt" [con_Alt] |
|---|
