Commit 3e046357 authored by Heiko Becker's avatar Heiko Becker

Start working on toy example proof, add coq definitions

parent c40ad60b
(**
Formalization of the base expression language for the daisy framework
**)
Require Import Coq.Reals.Reals.
Set Implicit Arguments.
(**
Expressions will use binary operators.
Define them first
**)
Inductive binop : Type := Plus | Sub | Mult | Div.
(**
Next define an evaluation function for binary operators on reals.
Errors are added on the expression evaluation level later.
**)
Fixpoint eval_binop (o:binop) (v1:R) (v2:R) :=
match o with
| Plus => Rplus v1 v2
| Sub => Rminus v1 v2
| Mult => Rmult v1 v2
| Div => Rdiv v1 v2
end.
(*
Define expressions parametric over some value type V.
Will ease reasoning about different instantiations later.
*)
Inductive exp (V:Type): Type :=
Var: nat -> exp V
| Const: V -> exp V
| Binop: binop -> exp V -> exp V -> exp V.
(**
Define the machine epsilon for floating point operations.
FIXME: Currently set to 1.0 instead of the concrete value!
**)
Definition m_eps:R := 1.
(**
Define a perturbation function to ease writing of basic definitions
**)
Definition perturb (r:R) (e:R) :=
Rmult r (Rplus 1 e).
(**
Define expression evaluation parametric by an "error function".
This function will be used later to express float computations using a perturbation
of the real valued computation by (1 + d)
Additionally we need an "error id" function which uniquely numbers an expression.
**)
Fixpoint eval_err (e:exp R) (err_fun:exp R-> R) (env:nat -> R) :=
match e with
|Var _ n => perturb (env n) (err_fun (Var _ n))
|Const v => perturb v (err_fun (Const v))
|Binop op e1 e2 => let v1 := eval_err e1 err_fun env in
let v2 := eval_err e2 err_fun env in
perturb (eval_binop op v1 v2) (err_fun (Binop op e1 e2))
end.
(**
Define real evaluation as stated above:
**)
Definition eval_real (e:exp R) (env:nat -> R) := eval_err e (fun x => R0) env.
(**
float evaluation is non-deterministic, since the perturbation is existencially quantified
--> state as predicate when float evaluation using errors is valid, related to errors
**)
Definition is_valid_err_float (err_fun: nat -> R) : Prop :=
forall id, exists n:R,
(n = err_fun id \/ (Ropp n) = err_fun id) /\
Rle (Rabs n) m_eps.
(**
Using the parametric expressions, define boolean expressions for conditionals
**)
Inductive bexp (V:Type) : Type :=
leq: exp V -> exp V -> bexp V
| less: exp V -> exp V -> bexp V.
(**
Define evaluation of booleans for reals
**)
Fixpoint bval_SIMPS (b:bexp R) (env:nat -> R) (eval: exp R -> (nat -> R) -> R) :=
match b with
|leq e1 e2 => Rle (eval e1 env) (eval e2 env)
|less e1 e2 => Rlt (eval e1 env) (eval e2 env)
end.
(**
Simplify arithmetic later by making > >= only abbreviations
**)
Definition gr := fun (V:Type) (e1: exp V) (e2: exp V) => less e2 e1.
Definition greq := fun (V:Type) (e1:exp V) (e2: exp V) => leq e2 e1.
\ No newline at end of file
...@@ -5,6 +5,21 @@ ...@@ -5,6 +5,21 @@
needs "Infra/tactics.hl";; needs "Infra/tactics.hl";;
(* needs "/home/heiko/Git_Repos/hol-light/IEEE/make.ml";; *) (* needs "/home/heiko/Git_Repos/hol-light/IEEE/make.ml";; *)
(*
Expressions will use binary operators.
Define them first
*)
let binop_INDUCT, binop_REC = define_type
"binop = Plus | Sub | Mult | Div ";;
(*
Define an evaluation function for binary operators.
Errors are added on the expression evaluation level later
*)
let eval_binop = new_recursive_definition binop_REC
`(eval_binop Plus v1 v2 = v1 + v2) /\
(eval_binop Sub v1 v2 = v1 - v2) /\
(eval_binop Mult v1 v2 = v1 * v2) /\
(eval_binop Div v1 v2 = v1 / v2)`;;
(* (*
Define expressions parametric over some value type V. Define expressions parametric over some value type V.
Will ease reasoning about different instantiations later. Will ease reasoning about different instantiations later.
...@@ -12,21 +27,16 @@ needs "Infra/tactics.hl";; ...@@ -12,21 +27,16 @@ needs "Infra/tactics.hl";;
let exp_INDUCT, exp_REC= define_type let exp_INDUCT, exp_REC= define_type
"exp = Var num "exp = Var num
| Const V | Const V
| Plus exp exp | Binop binop exp exp";;
| Sub exp exp
| Mult exp exp
| Div exp exp";;
(* (*
Define the machine epsilon for floating point operations. Define the machine epsilon for floating point operations.
FIXME: Currently set to 1.0 instead of the concrete value! FIXME: Currently set to 1.0 instead of the concrete value!
*) *)
let m_eps = define `m_eps:real = (&1)`;; let m_eps = define `m_eps:real = (&1)`;;
(* (*
Define a perturbation function to ease writing of basic definitions Define a perturbation function to ease writing of basic definitions
*) *)
let perturb_def = define `(perturb:real->real->real) = \r e. e * ((&1) + e)`;; let perturb = define `(perturb:real->real->real) = \r e. r * ((&1) + e)`;;
(* (*
Define expression evaluation parametric by an "error function". Define expression evaluation parametric by an "error function".
This function will be used later to express float computations using a perturbation This function will be used later to express float computations using a perturbation
...@@ -34,32 +44,19 @@ let perturb_def = define `(perturb:real->real->real) = \r e. e * ((&1) + e)`;; ...@@ -34,32 +44,19 @@ let perturb_def = define `(perturb:real->real->real) = \r e. e * ((&1) + e)`;;
Additionally we need an "error id" function which uniquely numbers an expression. Additionally we need an "error id" function which uniquely numbers an expression.
*) *)
let eval_err = new_recursive_definition exp_REC let eval_err = new_recursive_definition exp_REC
`(eval_err (Var name) err_fun err_id_fun env `(eval_err (Var name) err_fun env
= perturb (env name) (err_fun (err_id_fun (Var name)))) /\ = perturb (env name) (err_fun (Var name))) /\
(eval_err (Const v) err_fun err_id_fun env (eval_err (Const v) err_fun env
= perturb v (err_fun (err_id_fun (Const v)))) /\ = perturb v (err_fun (Const v))) /\
(eval_err (Plus e1 e2) err_fun err_id_fun env (eval_err (Binop binop e1 e2) err_fun env
= perturb ( = perturb (eval_binop binop (eval_err e1 err_fun env) (eval_err e2 err_fun env))
(eval_err e1 err_fun err_id_fun env) + (eval_err e2 err_fun err_id_fun env)) (err_fun (Binop binop e1 e2)))`;;
(err_fun (err_id_fun (Plus e1 e2)))) /\
(eval_err (Sub e1 e2) err_fun err_id_fun env
= perturb (
(eval_err e1 err_fun err_id_fun env) - (eval_err e2 err_fun err_id_fun env))
(err_fun (err_id_fun (Sub e1 e2)))) /\
(eval_err (Mult e1 e2)err_fun err_id_fun env
= perturb (
(eval_err e1 err_fun err_id_fun env) * (eval_err e2 err_fun err_id_fun env))
(err_fun (err_id_fun (Mult e1 e2)))) /\
(eval_err (Div e1 e2) err_fun err_id_fun env
= perturb (
(eval_err e1 err_fun err_id_fun env) / (eval_err e2 err_fun err_id_fun env))
(err_fun (err_id_fun (Div e1 e2))))`;;
(* (*
Define real evaluation as stated above: Define real evaluation as stated above:
*) *)
let eval_real = define let eval_real = define
`eval_real (e:(real)exp) (env:num->real) = eval_err e (\x. &0) (\x. &0) env`;; `eval_real (e:(real)exp) (env:num->real) = eval_err e (\x. &0) env`;;
(* (*
float evaluation is non-deterministic, since the perturbation is existencially quantified float evaluation is non-deterministic, since the perturbation is existencially quantified
......
(* (*
Toy Example to get a feeling for what needs to be done for certificate checking
*) *)
needs "daisy_lang.hl";; needs "daisy_lang.hl";;
...@@ -8,7 +8,25 @@ let prg = define ...@@ -8,7 +8,25 @@ let prg = define
Let 1 (Mult (Const (&2)) (Var 2)) Let 1 (Mult (Const (&2)) (Var 2))
(Ret (Mult (Const (&3)) (Var 1)))`;; (Ret (Mult (Const (&3)) (Var 1)))`;;
let prg_float = define let abs_err = define `abs_err = &1`;; (* TODO: FIXME *)
`prg_float:(float)cmd =
g `!fl_err_fun err_ids env env_final_real env_final_float.
is_valid_err_float fl_err_fun ==>
bstep prg env eval_real Nop env_final_real ==>
bstep prg env (\e. eval_err e fl_err_fun err_ids) Nop env_final_float ==>
abs (env_final_real 0 - env_final_float 0) <= abs_err`;;
g ` e (REWRITE_TAC [prg]);;
e (INTRO_TAC
"!fl_err_fun err_ids env env_final_real env_final_float;
error_fl_valid; terminates_real; terminates_float");;
e (SUBGOAL_THEN `?v. eval_real (Mult (Const (&2)) (Var 2)) env = v` (LABEL_TAC "exists_val"));;
e (REWRITE_TAC[eval_real;eval_err]);;
e (REWRITE_TAC[perturb]);;
e (EXISTS_TAC `&0`);;
e (REAL_ARITH_TAC);;
e (REMOVE_THEN "exists_val" (DESTRUCT_TAC "@v. val_def"));;
e (SUBGOAL_THEN `bstep (Ret (Mult (Const (&3)) (Var 1))) (upd_env 1 v env) eval_real Nop env_final_real` ASSUME_TAC);;
e (ASM_MESON_TAC[bstep_CASES]);;
e (REWRITE_TAC[bstep_CASES]);;
b();;
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment