Require Import Coq.Lists.List.
Require Import Coq.Init.Specif.
Require Import HaskKinds.
-Require Import HaskLiteralsAndTyCons.
+Require Import HaskLiterals.
+Require Import HaskTyCons.
Require Import HaskWeakTypes.
Require Import HaskWeakVars.
Require Import HaskWeak.
Require Import HaskStrongTypes.
Require Import HaskStrong.
Require Import HaskCoreVars.
-
-(* can remove *)
-Require Import HaskStrongToWeak.
+Require Import HaskCoreToWeak.
+Require Import HaskCoreTypes.
Open Scope string_scope.
Definition TyVarResolver Γ := forall wt:WeakTypeVar, ???(HaskTyVar Γ wt).
Definition CoVarResolver Γ Δ := forall wt:WeakCoerVar, ???(HaskCoVar Γ Δ).
-Definition upφ {Γ}(tv:WeakTypeVar)(φ:TyVarResolver Γ) : TyVarResolver ((tv:Kind)::Γ).
+Definition lamer {a}{b}{c}{κ}(lt:HaskType (app (app a b) c) κ) : HaskType (app a (app b c)) κ.
+ rewrite <- ass_app in lt.
+ exact lt.
+ Defined.
+
+Definition upPhi {Γ}(tv:WeakTypeVar)(φ:TyVarResolver Γ) : TyVarResolver ((tv:Kind)::Γ).
unfold TyVarResolver.
refine (fun tv' =>
if eqd_dec tv tv'
rewrite <- _H; apply fresh.
Defined.
-Definition upφ' {Γ}(tvs:list WeakTypeVar)(φ:TyVarResolver Γ)
+Definition upPhi2 {Γ}(tvs:list WeakTypeVar)(φ:TyVarResolver Γ)
: (TyVarResolver (app (map (fun tv:WeakTypeVar => tv:Kind) tvs) Γ)).
induction tvs.
apply φ.
simpl.
- apply upφ.
+ apply upPhi.
apply IHtvs.
Defined.
apply X.
Defined.
-Definition substφ {Γ:TypeEnv}(lk:list Kind)(θ:IList _ (fun κ => HaskType Γ κ) lk){κ} : HaskType (app lk Γ) κ -> HaskType Γ κ.
+Definition substphi {Γ:TypeEnv}(lk:list Kind)(θ:IList _ (fun κ => HaskType Γ κ) lk){κ} : HaskType (app lk Γ) κ -> HaskType Γ κ.
induction lk.
intro q; apply q.
simpl.
(* this is a StrongAltCon plus some stuff we know about StrongAltCons which we've built ourselves *)
Record StrongAltConPlusJunk {tc:TyCon} :=
{ sacpj_sac : @StrongAltCon tc
-; sacpj_φ : forall Γ (φ:TyVarResolver Γ ), (TyVarResolver (sac_Γ sacpj_sac Γ))
-; sacpj_ψ : forall Γ Δ atypes (ψ:CoVarResolver Γ Δ), CoVarResolver _ (sac_Δ sacpj_sac Γ atypes (weakCK'' Δ))
+; sacpj_phi : forall Γ (φ:TyVarResolver Γ ), (TyVarResolver (sac_gamma sacpj_sac Γ))
+; sacpj_psi : forall Γ Δ atypes (ψ:CoVarResolver Γ Δ), CoVarResolver _ (sac_delta sacpj_sac Γ atypes (weakCK'' Δ))
}.
Implicit Arguments StrongAltConPlusJunk [ ].
Coercion sacpj_sac : StrongAltConPlusJunk >-> StrongAltCon.
Definition mkPhi (lv:list WeakTypeVar)
: (TyVarResolver (map (fun x:WeakTypeVar => x:Kind) lv)).
- set (upφ'(Γ:=nil) lv emptyφ) as φ'.
- rewrite <- app_nil_end in φ'.
- apply φ'.
+ set (upPhi2(Γ:=nil) lv emptyφ) as φ2.
+ rewrite <- app_nil_end in φ2.
+ apply φ2.
Defined.
Definition dataConExKinds dc := vec_map (fun x:WeakTypeVar => (x:Kind)) (list2vec (dataConExTyVars dc)).
Ltac matchThings T1 T2 S :=
destruct (eqd_dec T1 T2) as [matchTypeVars_pf|];
- [ idtac | apply (Error (S +++ T1 +++ " " +++ T2)) ].
+ [ idtac | apply (Error (S +++ toString T1 +++ " " +++ toString T2)) ].
Definition mkTAll' {κ}{Γ} : HaskType (κ :: Γ) ★ -> (forall TV (ite:InstantiatedTypeEnv TV Γ), TV κ -> RawHaskType TV ★).
intros.
Definition weakTypeToType : forall {Γ:TypeEnv}(φ:TyVarResolver Γ)(t:WeakType), ???(HaskTypeOfSomeKind Γ).
refine (fix weakTypeToType {Γ:TypeEnv}(φ:TyVarResolver Γ)(t:WeakType) {struct t} : ???(HaskTypeOfSomeKind Γ) :=
- addErrorMessage ("weakTypeToType " +++ t)
+ addErrorMessage ("weakTypeToType " +++ toString t)
match t with
| WFunTyCon => let case_WFunTyCon := tt in OK (haskTypeOfSomeKind (fun TV ite => TArrow))
| WTyCon tc => let case_WTyCon := tt in _
| WIParam _ ty => let case_WIParam := tt in Error "weakTypeToType: WIParam not implemented"
| WAppTy t1 t2 => let case_WAppTy := tt in weakTypeToType _ φ t1 >>= fun t1' => weakTypeToType _ φ t2 >>= fun t2' => _
| WTyVarTy v => let case_WTyVarTy := tt in φ v >>= fun v' => _
- | WForAllTy wtv t => let case_WForAllTy := tt in weakTypeToType _ (upφ wtv φ) t >>= fun t => _
- | WCodeTy ec tbody => let case_WCodeTy := tt in weakTypeToType _ φ tbody >>= fun tbody' => φ (@fixkind ★ ec) >>= fun ec' => _
+ | WForAllTy wtv t => let case_WForAllTy := tt in weakTypeToType _ (upPhi wtv φ) t >>= fun t => _
+ | WCodeTy ec tbody => let case_WCodeTy := tt in weakTypeToType _ φ tbody
+ >>= fun tbody' => φ (@fixkind ECKind ec) >>= fun ec' => _
| WCoFunTy t1 t2 t3 => let case_WCoFunTy := tt in
weakTypeToType _ φ t1 >>= fun t1' =>
weakTypeToType _ φ t2 >>= fun t2' =>
end
| tx::lt' => weakTypeToType Γ φ tx >>= fun t' =>
match lk as LK return ???(forall TV (ite:InstantiatedTypeEnv TV Γ), @RawHaskTypeList TV LK) with
- | nil => Error "WTyFunApp applied to too many types"
+ | nil => Error ("WTyFunApp applied to too many types"(* +++ eol +++
+ " tyCon= " +++ toString tc +++ eol +++
+ " tyConKindArgs= " +++ toString (fst (tyFunKind tc)) +++ eol +++
+ " tyConKindResult= " +++ toString (snd (tyFunKind tc)) +++ eol +++
+ " types= " +++ toString lt +++ eol*))
| k::lk' => weakTypeListToTypeList lk' lt' >>= fun rhtl' =>
let case_weakTypeListToTypeList := tt in _
end
end
) (fst (tyFunKind tc)) lt) >>= fun lt' => let case_WTyFunApp := tt in _
end ); clear weakTypeToType.
+ apply ConcatenableString.
destruct case_WTyVarTy.
apply (addErrorMessage "case_WTyVarTy").
apply (addErrorMessage "case_WAppTy").
destruct t1' as [k1' t1'].
destruct t2' as [k2' t2'].
- set ("tried to apply type "+++t1'+++" of kind "+++k1'+++" to type "+++t2'+++" of kind "+++k2') as err.
+ set ("tried to apply type "+++toString t1'+++" of kind "+++toString k1'+++" to type "+++
+ toString t2'+++" of kind "+++toString k2') as err.
destruct k1';
try (matchThings k1'1 k2' "Kind mismatch in WAppTy: ";
subst; apply OK; apply (haskTypeOfSomeKind (fun TV env => TApp (t1' TV env) (t2' TV env))));
apply (Error ("Kind mismatch in WAppTy: "+++err)).
-
+
destruct case_weakTypeListToTypeList.
apply (addErrorMessage "case_weakTypeListToTypeList").
destruct t' as [ k' t' ].
apply OK.
eapply haskTypeOfSomeKind.
unfold HaskType; intros.
- apply TyFunApp.
+ apply (TyFunApp tc (fst (tyFunKind tc)) (snd (tyFunKind tc))).
apply lt'.
apply X.
intro ct.
apply (addErrorMessage "weakTypeToType'").
set (ilmap (@weakT' _ (vec2list (dataConExKinds dc))) avars) as avars'.
- set (@substφ _ _ avars') as q.
- set (upφ' (tyConTyVars tc) (mkPhi (dataConExTyVars dc))) as φ'.
- set (@weakTypeToType _ φ' ct) as t.
+ set (@substphi _ _ avars') as q.
+ set (upPhi2 (tyConTyVars tc) (mkPhi (dataConExTyVars dc))) as φ2.
+ set (@weakTypeToType _ φ2 ct) as t.
destruct t as [|t]; try apply (Error error_message).
destruct t as [tk t].
matchThings tk ★ "weakTypeToType'".
Definition mkStrongAltConPlusJunk : StrongAltConPlusJunk tc.
refine
{| sacpj_sac := mkStrongAltCon
- ; sacpj_φ := fun Γ φ => (fun htv => φ htv >>= fun htv' => OK (weakV' htv'))
- ; sacpj_ψ :=
+ ; sacpj_phi := fun Γ φ => (fun htv => φ htv >>= fun htv' => OK (weakV' htv'))
+ ; sacpj_psi :=
fun Γ Δ avars ψ => (fun htv => ψ htv >>= fun htv' => OK (_ (weakCV' (vec2list (sac_ekinds mkStrongAltCon)) htv')))
|}.
intro.
- unfold sac_Γ.
+ unfold sac_gamma.
unfold HaskCoVar in *.
intros.
apply (x TV CV env).
simpl in cenv.
- unfold sac_Δ in *.
+ unfold sac_delta in *.
unfold InstantiatedCoercionEnv in *.
apply vec_chop' in cenv.
apply cenv.
set ((dataConTyCon c):TyCon) as tc' in *.
set (eqd_dec tc tc') as eqpf; destruct eqpf;
[ idtac
- | apply (Error ("in a case of tycon "+++tc+++", found a branch with datacon "+++(dc:CoreDataCon))) ]; subst.
+ | apply (Error ("in a case of tycon "+++toString tc+++", found a branch with datacon "+++toString (dc:CoreDataCon))) ]; subst.
apply OK.
eapply mkStrongAltConPlusJunk.
simpl in *.
; sac_altcon := WeakLitAlt h
|} |}.
intro; intro φ; apply φ.
- intro; intro; intro; intro ψ. simpl. unfold sac_Γ; simpl. unfold sac_Δ; simpl.
+ intro; intro; intro; intro ψ. simpl. unfold sac_gamma; simpl. unfold sac_delta; simpl.
rewrite weakCK'_nil_inert. apply ψ.
apply OK; refine {| sacpj_sac := {|
sac_ekinds := vec_nil ; sac_coercions := fun _ _ => vec_nil ; sac_types := fun _ _ => vec_nil
; sac_altcon := WeakDEFAULT |} |}.
intro; intro φ; apply φ.
- intro; intro; intro; intro ψ. simpl. unfold sac_Γ; simpl. unfold sac_Δ; simpl.
+ intro; intro; intro; intro ψ. simpl. unfold sac_gamma; simpl. unfold sac_delta; simpl.
rewrite weakCK'_nil_inert. apply ψ.
Defined.
Variable weakCoercionToHaskCoercion : forall Γ Δ κ, WeakCoercion -> HaskCoercion Γ Δ κ.
-Definition weakψ {Γ}{Δ:CoercionEnv Γ} {κ}(ψ:WeakCoerVar -> ???(HaskCoVar Γ Δ)) :
+Definition weakPsi {Γ}{Δ:CoercionEnv Γ} {κ}(ψ:WeakCoerVar -> ???(HaskCoVar Γ Δ)) :
WeakCoerVar -> ???(HaskCoVar Γ (κ::Δ)).
intros.
refine (ψ X >>= _).
Defined.
(* attempt to "cast" an expression by simply checking if it already had the desired type, and failing otherwise *)
-Definition castExpr (we:WeakExpr)(err_msg:string) {Γ} {Δ} {ξ} {τ} τ' (e:@Expr _ CoreVarEqDecidable Γ Δ ξ τ)
- : ???(@Expr _ CoreVarEqDecidable Γ Δ ξ τ').
+Definition castExpr (we:WeakExpr)(err_msg:string) {Γ} {Δ} {ξ} {τ} {l} τ' l' (e:@Expr _ CoreVarEqDecidable Γ Δ ξ τ l)
+ : ???(@Expr _ CoreVarEqDecidable Γ Δ ξ τ' l').
apply (addErrorMessage ("castExpr " +++ err_msg)).
intros.
- destruct τ as [τ l].
- destruct τ' as [τ' l'].
destruct (eqd_dec l l'); [ idtac
| apply (Error ("level mismatch in castExpr, invoked by "+++err_msg+++eol+++
- " got: " +++(fold_left (fun x y => y+++","+++y) (map haskTyVarToType l) "")+++eol+++
- " wanted: "+++(fold_left (fun x y => x+++","+++y) (map haskTyVarToType l') "")
+ " got: " +++(fold_left (fun x y => y+++","+++y) (map (toString ○ haskTyVarToType) l) "")+++eol+++
+ " wanted: "+++(fold_left (fun x y => x+++","+++y) (map (toString ○ haskTyVarToType) l') "")
)) ].
destruct (eqd_dec τ τ'); [ idtac
| apply (Error ("type mismatch in castExpr, invoked by "+++err_msg+++eol+++
- " got: " +++τ+++eol+++
- " wanted: "+++τ'
+ " got: " +++toString τ+++eol+++
+ " wanted: "+++toString τ'
)) ].
subst.
apply OK.
Defined.
Definition coVarKind (wcv:WeakCoerVar) : Kind :=
- match wcv with weakCoerVar _ κ _ _ => κ end.
+ match wcv with weakCoerVar _ t _ => (kindOfCoreType (weakTypeToCoreType t)) end.
Coercion coVarKind : WeakCoerVar >-> Kind.
Definition weakTypeToTypeOfKind : forall {Γ:TypeEnv}(φ:TyVarResolver Γ)(t:WeakType)(κ:Kind), ???(HaskType Γ κ).
| T_Branch b1 b2 => doesWeakVarOccurAlts wev b1 || doesWeakVarOccurAlts wev b2
end.
-(*Definition ensureCaseBindersAreNotUsed (we:WeakExpr) : UniqM WeakExpr := FIXME *)
+Definition checkDistinct :
+ forall {V}(EQ:EqDecidable V)(lv:list V), ???(distinct lv).
+ intros.
+ set (distinct_decidable lv) as q.
+ destruct q.
+ exact (OK d).
+ exact (Error "checkDistinct failed").
+ Defined.
+
+(* FIXME: check the kind of the type of the weakexprvar to support >0 *)
+Definition mkGlobal Γ (τ:HaskType Γ ★) (wev:WeakExprVar) : Global Γ.
+ refine {| glob_kinds := nil |}.
+ apply wev.
+ intros.
+ apply τ.
+ Defined.
Definition weakExprToStrongExpr : forall
(Γ:TypeEnv)
(ig:CoreVar -> bool)
(τ:HaskType Γ ★)
(lev:HaskLevel Γ),
- WeakExpr -> ???(@Expr _ CoreVarEqDecidable Γ Δ ξ (τ @@ lev) ).
+ WeakExpr -> ???(@Expr _ CoreVarEqDecidable Γ Δ ξ τ lev ).
refine ((
fix weakExprToStrongExpr
(Γ:TypeEnv)
(ig:CoreVar -> bool)
(τ:HaskType Γ ★)
(lev:HaskLevel Γ)
- (we:WeakExpr) : ???(@Expr _ CoreVarEqDecidable Γ Δ ξ (τ @@ lev) ) :=
- addErrorMessage ("in weakExprToStrongExpr " +++ we)
+ (we:WeakExpr) : ???(@Expr _ CoreVarEqDecidable Γ Δ ξ τ lev ) :=
+ addErrorMessage ("in weakExprToStrongExpr " +++ toString we)
match we with
| WEVar v => if ig v
- then OK (EGlobal Γ Δ ξ (τ@@lev) v)
- else castExpr we ("WEVar "+++(v:CoreVar)) (τ @@ lev) (EVar Γ Δ ξ v)
+ then OK ((EGlobal Γ Δ ξ (mkGlobal Γ τ v) INil lev) : Expr Γ Δ ξ τ lev)
+ else castExpr we ("WEVar "+++toString (v:CoreVar)) τ lev (EVar Γ Δ ξ v)
- | WELit lit => castExpr we ("WELit "+++lit) (τ @@ lev) (ELit Γ Δ ξ lit lev)
+ | WELit lit => castExpr we ("WELit "+++toString lit) τ lev (ELit Γ Δ ξ lit lev)
| WELam ev ebody => weakTypeToTypeOfKind φ ev ★ >>= fun tv =>
weakTypeOfWeakExpr ebody >>= fun tbody =>
weakTypeToTypeOfKind φ tbody ★ >>= fun tbody' =>
- let ξ' := update_ξ ξ lev (((ev:CoreVar),tv)::nil) in
+ let ξ' := update_xi ξ lev (((ev:CoreVar),tv)::nil) in
let ig' := update_ig ig ((ev:CoreVar)::nil) in
weakExprToStrongExpr Γ Δ φ ψ ξ' ig' tbody' lev ebody >>= fun ebody' =>
- castExpr we "WELam" (τ@@lev) (ELam Γ Δ ξ tv tbody' lev ev ebody')
+ castExpr we "WELam" τ lev (ELam Γ Δ ξ tv tbody' lev ev ebody')
| WEBrak _ ec e tbody => φ (`ec) >>= fun ec' =>
weakTypeToTypeOfKind φ tbody ★ >>= fun tbody' =>
weakExprToStrongExpr Γ Δ φ ψ ξ ig tbody' ((ec')::lev) e >>= fun e' =>
- castExpr we "WEBrak" (τ@@lev) (EBrak Γ Δ ξ ec' tbody' lev e')
+ castExpr we "WEBrak" τ lev (EBrak Γ Δ ξ ec' tbody' lev e')
| WEEsc _ ec e tbody => φ ec >>= fun ec'' =>
weakTypeToTypeOfKind φ tbody ★ >>= fun tbody' =>
match lev with
| nil => Error "ill-leveled escapification"
| ec'::lev' => weakExprToStrongExpr Γ Δ φ ψ ξ ig (<[ ec' |- tbody' ]>) lev' e
- >>= fun e' => castExpr we "WEEsc" (τ@@lev) (EEsc Γ Δ ξ ec' tbody' lev' e')
+ >>= fun e' => castExpr we "WEEsc" τ lev (EEsc Γ Δ ξ ec' tbody' lev' e')
end
| WECSP _ ec e tbody => Error "FIXME: CSP not supported beyond HaskWeak stage"
- | WENote n e => weakExprToStrongExpr Γ Δ φ ψ ξ ig τ lev e >>= fun e' => OK (ENote _ _ _ _ n e')
+ | WENote n e => weakExprToStrongExpr Γ Δ φ ψ ξ ig τ lev e >>= fun e' => OK (ENote _ _ _ _ _ n e')
| WELet v ve ebody => weakTypeToTypeOfKind φ v ★ >>= fun tv =>
weakExprToStrongExpr Γ Δ φ ψ ξ ig tv lev ve >>= fun ve' =>
- weakExprToStrongExpr Γ Δ φ ψ (update_ξ ξ lev (((v:CoreVar),tv)::nil))
+ weakExprToStrongExpr Γ Δ φ ψ (update_xi ξ lev (((v:CoreVar),tv)::nil))
(update_ig ig ((v:CoreVar)::nil)) τ lev ebody
>>= fun ebody' =>
OK (ELet _ _ _ tv _ lev (v:CoreVar) ve' ebody')
weakExprToStrongExpr Γ Δ φ ψ ξ ig (t2'--->τ) lev e1 >>= fun e1' =>
OK (EApp _ _ _ _ _ _ e1' e2')
- | WETyLam tv e => let φ' := upφ tv φ in
+ | WETyLam tv e => let φ2 := upPhi tv φ in
weakTypeOfWeakExpr e >>= fun te =>
- weakTypeToTypeOfKind φ' te ★ >>= fun τ' =>
- weakExprToStrongExpr _ (weakCE Δ) φ'
- (fun x => (ψ x) >>= fun y => OK (weakCV y)) (weakLT○ξ) ig _ (weakL lev) e
- >>= fun e' => castExpr we "WETyLam2" _ (ETyLam Γ Δ ξ tv (mkTAll' τ') lev e')
+ weakTypeToTypeOfKind φ2 te ★ >>= fun τ' =>
+ weakExprToStrongExpr _ (weakCE_(n:=O) Δ) φ2
+ (fun x => (ψ x) >>= fun y =>
+ OK (weakCV_ y)) (weakLT_○ξ) ig _ (weakL_ lev) e
+ >>= fun e' => castExpr we "WETyLam2" _ _
+ (ETyLam Γ Δ ξ tv (mkTAll' τ') lev 0 e')
| WETyApp e t => weakTypeOfWeakExpr e >>= fun te =>
match te with
| WForAllTy wtv te' =>
- let φ' := upφ wtv φ in
- weakTypeToTypeOfKind φ' te' ★ >>= fun te'' =>
+ let φ2 := upPhi wtv φ in
+ weakTypeToTypeOfKind φ2 te' ★ >>= fun te'' =>
weakExprToStrongExpr Γ Δ φ ψ ξ ig (mkTAll te'') lev e >>= fun e' =>
weakTypeToTypeOfKind φ t (wtv:Kind) >>= fun t' =>
- castExpr we "WETyApp" _ (ETyApp Γ Δ wtv (mkTAll' te'') t' ξ lev e')
- | _ => Error ("weakTypeToType: WETyApp body with type "+++te)
+ castExpr we "WETyApp" _ _ (ETyApp Γ Δ wtv (mkTAll' te'') t' ξ lev e')
+ | _ => Error ("weakTypeToType: WETyApp body with type "+++toString te)
end
| WECoApp e co => weakTypeOfWeakExpr e >>= fun te =>
weakTypeToTypeOfKind φ t2 κ >>= fun t2'' =>
weakTypeToTypeOfKind φ t3 ★ >>= fun t3'' =>
weakExprToStrongExpr Γ Δ φ ψ ξ ig (t1'' ∼∼ t2'' ⇒ τ) lev e >>= fun e' =>
- castExpr we "WECoApp" _ e' >>= fun e'' =>
+ castExpr we "WECoApp" _ _ e' >>= fun e'' =>
OK (ECoApp Γ Δ κ t1'' t2''
(weakCoercionToHaskCoercion _ _ _ co) τ ξ lev e'')
end
- | _ => Error ("weakTypeToType: WECoApp body with type "+++te)
+ | _ => Error ("weakTypeToType: WECoApp body with type "+++toString te)
end
- | WECoLam cv e => let (_,_,t1,t2) := cv in
+ | 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 Γ (_ :: Δ) φ (weakψ ψ) ξ ig te' lev e >>= fun e' =>
- castExpr we "WECoLam" _ (ECoLam Γ Δ cv te' t1' t2' ξ lev e')
+ 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" _
+ castExpr we "WECast" _ _
(ECast Γ Δ ξ t1' t2' (weakCoercionToHaskCoercion _ _ _ co) lev e')
| WELetRec rb e =>
- let ξ' := update_ξ ξ lev _ in
+ 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))
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')
+ OK (ELetRec Γ Δ ξ lev τ _ _ binds' e')
| WECase vscrut escrut tbranches tc avars alts =>
weakTypeOfWeakExpr escrut >>= fun tscrut =>
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_Γ sac Γ) (sac_Δ sac Γ avars' (weakCK'' Δ))(scbwv_ξ scb ξ lev)(weakLT' (tbranches' @@ lev))}}) :=
+ 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)) =>
>>= fun exprvars' =>
(let case_pf := tt in _) >>= fun pf =>
let scb := @Build_StrongCaseBranchWithVVs CoreVar CoreVarEqDecidable tc Γ avars' sac exprvars' pf in
- weakExprToStrongExpr (sac_Γ sac Γ) (sac_Δ sac Γ avars' (weakCK'' Δ)) (sacpj_φ sac _ φ)
- (sacpj_ψ sac _ _ avars' ψ)
- (scbwv_ξ scb ξ lev)
+ 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 [ _ ]
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.
-
+ 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 (ξ c).
simpl.
apply e1.
+ rewrite mapleaves.
+ apply rb_distinct.
destruct case_pf.
set (distinct_decidable (vec2list exprvars')) as dec.
projects / coq-hetmet.git / blobdiff