+ | WECoApp e co => weakTypeOfWeakExpr e >>= fun te =>
+ match te with
+ | WCoFunTy t1 t2 t3 =>
+ weakTypeToType φ t1 >>= fun t1' =>
+ match t1' with
+ haskTypeOfSomeKind κ t1'' =>
+ weakTypeToTypeOfKind φ t2 κ >>= fun t2'' =>
+ weakTypeToTypeOfKind φ t3 ★ >>= fun t3'' =>
+ weakExprToStrongExpr Γ Δ φ ψ ξ ig (t1'' ∼∼ t2'' ⇒ τ) lev e >>= fun e' =>
+ castExpr we "WECoApp" _ _ e' >>= fun e'' =>
+ OK (ECoApp Γ Δ κ t1'' t2''
+ (weakCoercionToHaskCoercion _ _ _ co) τ ξ lev e'')
+ end
+ | _ => Error ("weakTypeToType: WECoApp body with type "+++toString te)
+ end
+
+ | WECoLam cv e => let (_,t1,t2) := cv in
+ weakTypeOfWeakExpr e >>= fun te =>
+ weakTypeToTypeOfKind φ te ★ >>= fun te' =>
+ weakTypeToTypeOfKind φ t1 cv >>= fun t1' =>
+ weakTypeToTypeOfKind φ t2 cv >>= fun t2' =>
+ weakExprToStrongExpr Γ (_ :: Δ) φ (weakPsi ψ) ξ ig te' lev e >>= fun e' =>
+ castExpr we "WECoLam" _ _ (ECoLam Γ Δ cv te' t1' t2' ξ lev e')
+
+ | WECast e co => let (t1,t2) := weakCoercionTypes co in
+ weakTypeToTypeOfKind φ t1 ★ >>= fun t1' =>
+ weakTypeToTypeOfKind φ t2 ★ >>= fun t2' =>
+ weakExprToStrongExpr Γ Δ φ ψ ξ ig t1' lev e >>= fun e' =>
+ castExpr we "WECast" _ _
+ (ECast Γ Δ ξ t1' t2' (weakCoercionToHaskCoercion _ _ _ co) lev e')
+
+ | WELetRec rb e =>
+ let ξ' := update_xi ξ lev _ in
+ let ig' := update_ig ig (map (fun x:(WeakExprVar*_) => (fst x):CoreVar) (leaves rb)) in
+ let binds :=
+ (fix binds (t:Tree ??(WeakExprVar * WeakExpr))
+ : ???(ELetRecBindings Γ Δ ξ' lev (varsTypes t φ)) :=
+ match t with
+ | T_Leaf None => let case_nil := tt in OK (ELR_nil _ _ _ _)
+ | T_Leaf (Some (wev,e)) => let case_some := tt in (fun e' => _) (fun τ => weakExprToStrongExpr Γ Δ φ ψ ξ' ig' τ lev e)
+ | T_Branch b1 b2 =>
+ binds b1 >>= fun b1' =>
+ binds b2 >>= fun b2' =>
+ OK (ELR_branch Γ Δ ξ' lev _ _ b1' b2')
+ end) rb
+ in binds >>= fun binds' =>
+ checkDistinct CoreVarEqDecidable (map (@fst _ _) (leaves (varsTypes rb φ))) >>= fun rb_distinct =>
+ weakExprToStrongExpr Γ Δ φ ψ ξ' ig' τ lev e >>= fun e' =>
+ OK (ELetRec Γ Δ ξ lev τ _ _ binds' e')
+
+ | WECase vscrut escrut tbranches tc avars alts =>
+ weakTypeOfWeakExpr escrut >>= fun tscrut =>
+ weakTypeToTypeOfKind φ tscrut ★ >>= fun tscrut' =>
+ if doesWeakVarOccurAlts vscrut alts
+ then Error "encountered a Case which actually used its binder - these should have been desugared away!!"
+ else mkAvars avars (tyConKind tc) φ >>= fun avars' =>
+ weakTypeToTypeOfKind φ tbranches ★ >>= fun tbranches' =>
+ (fix mkTree (t:Tree ??(WeakAltCon*list WeakTypeVar*list WeakCoerVar*list WeakExprVar*WeakExpr)) : ???(Tree
+ ??{ sac : _ & {scb : StrongCaseBranchWithVVs CoreVar CoreVarEqDecidable tc avars' sac &
+ Expr (sac_gamma sac Γ) (sac_delta sac Γ avars' (weakCK'' Δ))(scbwv_xi scb ξ lev)(weakT' tbranches')(weakL' lev)}}) :=
+ match t with
+ | T_Leaf None => OK []
+ | T_Leaf (Some (ac,extyvars,coervars,exprvars,ebranch)) =>
+ mkStrongAltConPlusJunk' tc ac >>= fun sac =>
+ list2vecOrFail (map (fun ev:WeakExprVar => ev:CoreVar) exprvars) _ (fun _ _ => "WECase")
+ >>= fun exprvars' =>
+ (let case_pf := tt in _) >>= fun pf =>
+ let scb := @Build_StrongCaseBranchWithVVs CoreVar CoreVarEqDecidable tc Γ avars' sac exprvars' pf in
+ weakExprToStrongExpr (sac_gamma sac Γ) (sac_delta sac Γ avars' (weakCK'' Δ)) (sacpj_phi sac _ φ)
+ (sacpj_psi sac _ _ avars' ψ)
+ (scbwv_xi scb ξ lev)
+ (update_ig ig (map (@fst _ _) (vec2list (scbwv_varstypes scb))))
+ (weakT' tbranches') (weakL' lev) ebranch >>= fun ebranch' =>
+ let case_case := tt in OK [ _ ]
+ | T_Branch b1 b2 =>
+ mkTree b1 >>= fun b1' =>
+ mkTree b2 >>= fun b2' =>
+ OK (b1',,b2')
+ end) alts >>= fun tree =>
+
+ weakExprToStrongExpr Γ Δ φ ψ ξ ig (caseType tc avars') lev escrut >>= fun escrut' =>
+ castExpr we "ECase" τ lev (ECase Γ Δ ξ lev tc tbranches' avars' escrut' tree)
+ end)); try clear binds; try apply ConcatenableString.
+
+ destruct case_some.
+ apply (addErrorMessage "case_some").
+ simpl.
+ destruct (weakTypeToTypeOfKind φ wev ★); try apply (Error error_message).
+ matchThings h (unlev (ξ' wev)) "LetRec".
+ destruct wev.
+ rewrite matchTypeVars_pf.
+ clear matchTypeVars_pf.
+ set (e' (unlev (ξ' (weakExprVar c w)))) as e''.
+ destruct e''; try apply (Error error_message).
+ apply OK.
+ apply ELR_leaf.
+ unfold ξ'.
+ simpl.
+ induction (leaves (varsTypes rb φ)).
+ simpl; auto.
+ destruct (ξ c).
+ simpl.
+ apply e1.
+ rewrite mapleaves.
+ apply rb_distinct.
+
+ destruct case_pf.
+ set (distinct_decidable (vec2list exprvars')) as dec.
+ destruct dec; [ idtac | apply (Error "malformed HaskWeak: case branch with variables repeated") ].
+ apply OK; auto.
+
+ destruct case_case.
+ exists sac.
+ exists scb.
+ apply ebranch'.
+