Require Import General.
Require Import NaturalDeduction.
+Require Import NaturalDeductionContext.
Require Import HaskKinds.
Require Import HaskLiterals.
OK (eol+++eol+++eol+++
"\begin{preview}"+++eol+++
"$\displaystyle "+++
- toString (nd_ml_toLatexMath (@expr2proof _ _ _ _ _ _ e))+++
+ toString (nd_ml_toLatexMath (@expr2proof _ _ _ _ _ _ _ e))+++
" $"+++eol+++
"\end{preview}"+++eol+++eol+++eol)
)))))))).
ND Rule
[ Γ > Δ > Σ |- [a ---> s ]@lev ]
[ Γ > Δ > [a @@ lev],,Σ |- [ s ]@lev ].
- eapply nd_comp; [ idtac | eapply nd_rule; eapply RArrange; eapply RExch ].
+ eapply nd_comp; [ idtac | eapply nd_rule; eapply RArrange; eapply AExch ].
eapply nd_comp; [ idtac | eapply nd_rule; eapply RApp ].
eapply nd_comp; [ apply nd_rlecnac | idtac ].
apply nd_prod.
intro pf.
eapply nd_comp.
apply pf.
- eapply nd_comp; [ idtac | eapply nd_rule; eapply RArrange; apply RCanR ].
+ eapply nd_comp; [ idtac | eapply nd_rule; eapply RArrange; apply ACanR ].
apply curry.
Defined.
eapply nd_comp.
eapply nd_rule.
eapply RArrange.
- eapply RCanR.
- eapply nd_comp; [ idtac | eapply nd_rule; eapply RArrange; eapply RExch ].
+ eapply ACanR.
+ eapply nd_comp; [ idtac | eapply nd_rule; eapply RArrange; eapply AExch ].
apply curry.
Defined.
Section coqPassCoreToCore.
Context
+ (do_flatten : bool)
+ (do_skolemize : bool)
(hetmet_brak : CoreVar)
(hetmet_esc : CoreVar)
(hetmet_flatten : CoreVar)
((weakExprToStrongExpr Γ Δ φ ψ ξ (fun _ => true) τ nil we) >>= fun e =>
(addErrorMessage ("HaskStrong...")
- (let haskProof := skolemize_and_flatten_proof hetmet_flatten' hetmet_unflatten'
- hetmet_flattened_id' my_ga (@expr2proof _ _ _ _ _ _ e)
- in (* insert HaskProof-to-HaskProof manipulations here *)
- OK ((@proof2expr nat _ FreshNat _ _ (flatten_type τ@@nil) _ (fun _ => Prelude_error "unbound unique") _ haskProof) O)
- >>= fun e' =>
- (snd e') >>= fun e'' =>
- strongExprToWeakExpr hetmet_brak' hetmet_esc'
- mkWeakTypeVar mkWeakCoerVar mkWeakExprVar uniqueSupply
- (projT2 e'') INil
- >>= fun q =>
- OK (weakExprToCoreExpr q)
- )))))))))).
+ (if do_skolemize
+ then
+ (let haskProof := skolemize_and_flatten_proof hetmet_flatten' hetmet_unflatten'
+ hetmet_flattened_id' my_ga (@expr2proof _ _ _ _ _ _ _ e)
+ in (* insert HaskProof-to-HaskProof manipulations here *)
+ OK ((@proof2expr nat _ FreshNat _ _ (flatten_type τ) nil _
+ (fun _ => Prelude_error "unbound unique") _ haskProof) O)
+ >>= fun e' => (snd e') >>= fun e'' =>
+ strongExprToWeakExpr hetmet_brak' hetmet_esc'
+ mkWeakTypeVar mkWeakCoerVar mkWeakExprVar uniqueSupply
+ (projT2 e'') INil
+ >>= fun q => OK (weakExprToCoreExpr q))
+ else (if do_flatten
+ then
+ (let haskProof := flatten_proof (*hetmet_flatten' hetmet_unflatten'
+ hetmet_flattened_id' my_ga*) (@expr2proof _ _ _ _ _ _ _ e)
+ in (* insert HaskProof-to-HaskProof manipulations here *)
+ OK ((@proof2expr nat _ FreshNat _ _ τ nil _
+ (fun _ => Prelude_error "unbound unique") _ haskProof) O)
+ >>= fun e' => (snd e') >>= fun e'' =>
+ strongExprToWeakExpr hetmet_brak' hetmet_esc'
+ mkWeakTypeVar mkWeakCoerVar mkWeakExprVar uniqueSupply
+ (projT2 e'') INil
+ >>= fun q => OK (weakExprToCoreExpr q))
+ else
+ (let haskProof := @expr2proof _ _ _ _ _ _ _ e
+ in (* insert HaskProof-to-HaskProof manipulations here *)
+ OK ((@proof2expr nat _ FreshNat _ _ τ nil _
+ (fun _ => Prelude_error "unbound unique") _ haskProof) O)
+ >>= fun e' => (snd e') >>= fun e'' =>
+ strongExprToWeakExpr hetmet_brak' hetmet_esc'
+ mkWeakTypeVar mkWeakCoerVar mkWeakExprVar uniqueSupply
+ (projT2 e'') INil
+ >>= fun q => OK (weakExprToCoreExpr q))))
+ ))))))))).
Definition coreToCoreExpr (ce:@CoreExpr CoreVar) : (@CoreExpr CoreVar) :=
match coreToCoreExpr' ce with
End coqPassCoreToCore.
Definition coqPassCoreToCore
+ (do_flatten : bool)
+ (do_skolemize : bool)
(hetmet_brak : CoreVar)
(hetmet_esc : CoreVar)
(hetmet_flatten : CoreVar)
(hetmet_pga_curryl : CoreVar)
(hetmet_pga_curryr : CoreVar) : list (@CoreBind CoreVar) :=
coqPassCoreToCore'
+ do_flatten
+ do_skolemize
hetmet_brak
hetmet_esc
hetmet_flatten