(* $Id: Reflection.v,v 1.31 2000/11/10 11:27:34 freek Exp $ *)

Require Export CFields.

(* Tex_Prose
\section{Reflection}
*)

Section Reflection.

Definition varindex : Set := nat.

Inductive expr : Set :=
   expr_var  : varindex->expr
 | expr_int  : Z->expr
 | expr_plus : expr->expr->expr
 | expr_mult : expr->expr->expr
 | expr_div  : expr->expr->expr.

Definition expr_zero : expr := (expr_int `0`).
Definition expr_one : expr := (expr_int `1`).
Definition expr_nat [n:nat] : expr := (expr_int (inject_nat n)).
Definition expr_inv [e:expr] : expr := (expr_mult (expr_int `-1`) e).
Definition expr_minus [e,e':expr] : expr := (expr_plus e (expr_inv e')).
Fixpoint expr_power [n:nat] : expr->expr := [e:expr]
  Cases n of
    O => expr_one
  | (S m) => (expr_mult e (expr_power m e))
  end.

Variable F : CField.
Variable val : varindex->F.


(*	The following looks nice, but is not accepted: wf occurs in the
	TYPE of  rinterp

Fixpoint wf [e0: expr ] : Prop :=
  Cases e0 of
	(expr_var i)	   =>	(True)
	| (expr_mult e f)  => ((wf e)/\(wf f))
	| (expr_div e f)   => ((wf e)/\(wf f)/\((rinterp f) [#]Zero))
end
with rinterp [e0: expr ] : (wf e0) -> F :=
Cases e0 of
	(expr_var i)	  => ([_:?](val i))
	| (expr_mult e f) => ([_:?]((rinterp e)[*](rinterp f)))
	| (expr_div e f)  => ([z:(wf (expr_div e f))]
		((rinterp e)[/]((rinterp f)[//](snd ?? (snd ?? z)))))
end.
*)

Inductive interp : expr->F->Prop :=
   interp_var : (i:varindex)(z:F)((val i) [=] z)->
     (interp (expr_var i) z)
 | interp_int : (k:Z)(z:F)((Zring k) [=] z)->
     (interp (expr_int k) z)
 | interp_plus : (e,f:expr)(x,y,z:F)(x[+]y [=] z)->
     (interp e x)->(interp f y)->(interp (expr_plus e f) z)
 | interp_mult : (e,f:expr)(x,y,z:F)(x[*]y [=] z)->
     (interp e x)->(interp f y)->(interp (expr_mult e f) z)
 | interp_div : (e,f:expr)(x,y,z:F)(nzy:(y [#] Zero))(x[/](y[//]nzy) [=] z)->
     (interp e x)->(interp f y)->(interp (expr_div e f) z).

Definition wf [e:expr] := (Ex (interp e)).

Inductive xexpr : F->Set :=
   xexpr_var   : (i:varindex)(xexpr (val i))
 | xexpr_int   : (k:Z)(xexpr (Zring k))
 | xexpr_plus  : (x,y:F)(e:(xexpr x))(f:(xexpr y))(xexpr x[+]y)
 | xexpr_mult  : (x,y:F)(e:(xexpr x))(f:(xexpr y))(xexpr x[*]y)
 | xexpr_div   : (x,y:F)(e:(xexpr x))(f:(xexpr y))
                       (nzy:(y [#] Zero))(xexpr x[/](y[//]nzy))
(* more things rational translates: *)
 | xexpr_zero  : (xexpr Zero)
 | xexpr_one   : (xexpr One)
 | xexpr_nat   : (n:nat)(xexpr (Nring n))
 | xexpr_inv   : (x:F)(e:(xexpr x))(xexpr [--]x)
 | xexpr_minus : (x,y:F)(e:(xexpr x))(f:(xexpr y))(xexpr x[-]y)
 | xexpr_power : (x:F)(e:(xexpr x))(n:nat)(xexpr x[^]n).

Fixpoint xforget [x:F; e:(xexpr x)] : expr :=
  Cases e of
    (xexpr_var i) => (expr_var i)
  | (xexpr_int k) => (expr_int k)
  | (xexpr_plus _ _ e f) => (expr_plus (xforget ? e) (xforget ? f))
  | (xexpr_mult _ _ e f) => (expr_mult (xforget ? e) (xforget ? f))
  | (xexpr_div _ _ e f _) => (expr_div (xforget ? e) (xforget ? f))
  | (xexpr_zero) => (expr_zero)
  | (xexpr_one) => (expr_one)
  | (xexpr_nat n) => (expr_nat n)
  | (xexpr_inv _ e) => (expr_inv (xforget ? e))
  | (xexpr_minus _ _ e f) => (expr_minus (xforget ? e) (xforget ? f))
  | (xexpr_power _ e n) => (expr_power n (xforget ? e))
  end.

Definition xinterp := [x:F][e:(xexpr x)]x.

Lemma xexpr2interp : (x:F)(e:(xexpr x))(interp (xforget ? e) x).
Intros.
Elim e; Intros.
Apply (interp_var i); Algebra.
Apply (interp_int k); Algebra.
Apply (interp_plus (xforget ? e0) (xforget ? f) x0 y x0[+]y); Algebra.
Apply (interp_mult (xforget ? e0) (xforget ? f) x0 y x0[*]y); Algebra.
Apply (interp_div (xforget ? e0) (xforget ? f) x0 y x0[/](y[//]nzy) nzy);
  Algebra.
Apply (interp_int `0`); Algebra.
Apply (interp_int `1`); Step_final One::F.
Apply (interp_int (inject_nat n)); Algebra.
Apply (interp_mult (expr_int `-1`) (xforget ? e0) (Zring `-1`) x0 [--]x0);
  Algebra.
Apply (interp_int `-1`); Algebra.
Apply (interp_plus (xforget ? e0) (xforget ? (xexpr_inv ? f)) x0 [--]y x0[-]y);
  Algebra.
Apply (interp_mult (expr_int `-1`) (xforget ? f) (Zring `-1`) y [--]y);
  Algebra.
Apply (interp_int `-1`); Algebra.
Elim n.
Apply (interp_int `1`); Step_final One::F.
Intros.
Apply (interp_mult (xforget ? e0) (expr_power n0 (xforget ? e0))
  x0 x0[^]n0 x0[^](S n0)); Auto.
Step_final x0[^]n0[*]x0.
Qed.

Definition xexpr_diagram_commutes :
  (x:F)(e:(xexpr x))(interp (xforget ? e) (xinterp ? e)) :=
  xexpr2interp.

Lemma xexpr2wf : (x:F)(e:(xexpr x))(wf (xforget ? e)).
Intros.
Unfold wf.
Exists x.
Apply xexpr2interp.
Qed.

Record fexpr : Set :=
  { finterp : F;
    fexpr2xexpr : (xexpr finterp)
  }.

Definition fexpr_var := [i:varindex](Build_fexpr ? (xexpr_var i)).
Definition fexpr_int := [k:Z] (Build_fexpr ? (xexpr_int k)).
Definition fexpr_plus := [e,e':fexpr]
  (Build_fexpr ?
    (xexpr_plus (finterp e) (finterp e') (fexpr2xexpr e) (fexpr2xexpr e'))).
Definition fexpr_mult := [e,e':fexpr]
  (Build_fexpr ?
    (xexpr_mult (finterp e) (finterp e') (fexpr2xexpr e) (fexpr2xexpr e'))).
Definition fexpr_div := [e,e':fexpr][nz:(finterp e')[#]Zero]
  (Build_fexpr ?
    (xexpr_div (finterp e) (finterp e') (fexpr2xexpr e) (fexpr2xexpr e') nz)).

Definition fforget := [e:fexpr](xforget (finterp e) (fexpr2xexpr e)).

Lemma fexpr2interp : (e:fexpr)(interp (fforget e) (finterp e)).
Intros.
Elim e. Intros x e'.
Unfold fforget. Simpl.
Apply xexpr2interp.
Qed.

Lemma fexpr2wf : (e:fexpr)(wf (fforget e)).
Intros.
Unfold fforget.
Apply xexpr2wf.
Qed.

Load Opaque_algebra.

Lemma refl_interp : (e:expr)(x,y:F)(interp e x)->(interp e y)->
			(x [=] y).
Intro e.
Elim e.

Intros v x y Hx Hy.
Inversion Hx.
Inversion Hy.
Step_final (val v).

Intros k x y Hx Hy.
Inversion Hx.
Inversion Hy.
Step_final (Zring k)::F.

Intro e0.
Intros H e1 H0 x y H1 H2.
Inversion H1.
Inversion H2.
Step x0[+]y0.
Step_final x1[+]y1.

Intro e0.
Intros H e1 H0 x y H1 H2.
Inversion H1.
Inversion H2.
Step x0[*]y0.
Step_final x1[*]y1.

Intro e0; Intros.
Inversion H1.
Inversion H2.
Step x0[/](y0[//]nzy).
Step_final x1[/](y1[//]nzy0).

Qed.

Lemma interp_wd : (e:expr)(x,y:F)(interp e x)->(x [=] y)->(interp e y).
Intros.
Inversion H.
Apply interp_var. Step_final x.
Apply interp_int. Step_final x.
Apply interp_plus with x0 y0; Auto. Step_final x.
Apply interp_mult with x0 y0; Auto. Step_final x.
Apply interp_div with x0 y0 nzy; Auto. Step_final x.
Qed.


Lemma expr2fexpr_exists : (e:expr)(wf e)->
  (Ex [f:fexpr]
    ((fforget f) = e) /\
    ((x:F)(interp e x)->((finterp f) [=] x))).
Intros.
Elim H. Intros.
Elim H0; Intros.
Exists (fexpr_var i). Split. Auto.
Intros. Simpl. Inversion H2. Assumption.
Exists (fexpr_int k). Split. Auto.
Intros. Inversion H2. Assumption.
Elim H3. Elim H5. Intros.
Elim H6. Elim H7. Intros.
Exists (fexpr_plus x2 x1). Split.
Rewrite <- H8. Rewrite <- H10. Auto.
Intros.
Apply refl_interp with (expr_plus e0 f).
Apply interp_plus with x0 y.
Simpl; Algebra .
Assumption. Assumption. Assumption.
Elim H3. Elim H5. Intros.
Elim H6. Elim H7. Intros.
Exists (fexpr_mult x2 x1). Split.
Rewrite <- H8. Rewrite <- H10. Auto.
Intros.
Apply refl_interp with (expr_mult e0 f).
Apply interp_mult with x0 y.
Simpl; Algebra .
Assumption. Assumption. Assumption.
Elim H3. Elim H5. Intros.
Elim H6. Elim H7. Intros.
Cut (cs_ap F (finterp x1) Zero). Intro nzx1.
Exists (fexpr_div x2 x1 nzx1). Split.
Rewrite <- H8. Rewrite <- H10. Auto.
Intros.
Apply refl_interp with (expr_div e0 f).
Apply interp_div with x0 y nzy.
Simpl; Algebra .
Assumption. Assumption. Assumption.
Apply ap_well_def_lft_unfolded with y. Assumption.
Apply eq_symmetric_unfolded.
Apply H11. Assumption.
Qed.

(*
Ax_iom expr2fexpr : (e:expr)(wf e)->fexpr.

Ax_iom expr2fexpr_compat : (e:expr)(H:(wf e))
  (fforget (expr2fexpr e H)) = e.

Ax_iom expr2fexpr_corr : (e:expr)(H:(wf e))(x:F)(interp e x)->
  (finterp (expr2fexpr e H)) [=] x.
*)

End Reflection.

(*
Syntactic Definition Interp := (interp ??).
*)


