X-Git-Url: http://git.megacz.com/?p=coq-hetmet.git;a=blobdiff_plain;f=src%2FHaskStrongToWeak.v;h=ad1dee7faf013a1238ad37eb858befcfe3072e63;hp=dacdcae45f240a7aef6e0d3c30d4aa04f8cad629;hb=b3214686b18b2d6f6905394494da8d1c17587bdb;hpb=3d4dc42bf3f6e2ad7dc35b14ecb8facdb89e9324 diff --git a/src/HaskStrongToWeak.v b/src/HaskStrongToWeak.v index dacdcae..ad1dee7 100644 --- a/src/HaskStrongToWeak.v +++ b/src/HaskStrongToWeak.v @@ -156,11 +156,13 @@ Section HaskStrongToWeak. ; bind tbranches' = @typeToWeakType Γ _ tbranches ite ; bind escrut' = exprToWeakExpr χ escrut ite ; bind branches' = - ((fix caseBranches (tree:Tree ??{scb : StrongCaseBranchWithVVs VV _ _ _ & Expr _ _ _ _ }) + ((fix caseBranches (tree:Tree ??{sac : _ & { scb : StrongCaseBranchWithVVs VV _ _ _ sac & Expr _ _ _ _ } }) : UniqM (Tree ??(WeakAltCon*list WeakTypeVar*list WeakCoerVar*list WeakExprVar*WeakExpr)) := match tree with | T_Leaf None => return [] - | T_Leaf (Some x) => let (scb,e) := x in + | T_Leaf (Some x) => + let (sac,scb_e) := x in + let (scb,e) := scb_e in let varstypes := vec2list (scbwv_varstypes scb) in bind evars_ite = mfresh _ ite ; bind exprvars = seqM (map (fun vt:VV * HaskType _ ★ @@ -170,7 +172,7 @@ Section HaskStrongToWeak. varstypes) ; let χ' := update_χ' χ exprvars in bind e'' = exprToWeakExpr χ' e (snd evars_ite) - ; return [(sac_altcon scb, vec2list (fst evars_ite), nil, (map (@snd _ _) exprvars), e'')] + ; return [(sac_altcon sac, vec2list (fst evars_ite), nil, (map (@snd _ _) exprvars), e'')] | T_Branch b1 b2 => bind b1' = caseBranches b1 ; bind b2' = caseBranches b2 ; return (b1',,b2')