Merge branch 'reworked-ci' into 'master'

Rework CI to properly deal with HOL4

See merge request AVA/FloVer!4

.gitlab-ci.yml

-image: localhost:5000/flover
+image: heikobecker/coq-polyml-ci
 
 variables:
     GIT_SUBMODULE_STRATEGY: none
 
 stages:
   - compile
-  - regression
+#  - regression
 
 compile-coq:
   stage: compile
@@ -23,6 +23,6 @@ compile-hol:
     paths:
     - hol4/binary/
 
-regression-tests:
-  stage: regression
-  script: ./scripts/regressiontests.sh
\ No newline at end of file
+# regression-tests:
+#  stage: regression
+#  script: ./scripts/regressiontests.sh
\ No newline at end of file

Dockerfile

@@ -15,31 +15,18 @@ RUN opam init --comp=4.05.0 --auto-setup && \
 
 # Install coq and dependencies
 RUN opam repo add coq-released https://coq.inria.fr/opam/released && \
-    opam update && \
-    opam install coq.8.7.2 coq-flocq
+    opam update
+
+#Install coq 8.7.2 in a switch
+RUN opam switch -A 4.05.0 coq8.7.2
+RUN opam install coq.8.7.2 coq-flocq.2.6.1
+
+#Install coq 8.8 in a switch
+RUN opam switch -A 4.05.0 coq8.8
+RUN opam install coq.8.8.0 coq-flocq.2.6.1
 
 # Install polyml from git
 RUN git clone https://github.com/polyml/polyml.git polyml && \
     cd polyml && \
     git checkout v5.7 && \
     ./configure && make && make install
-
-ADD ./hol4/.HOLCOMMIT /root/HOLCOMMIT
-
-# RUN cat /root/HOLCOMMIT
-
-# RUN export HOLCOMMIT="$(cat /root/HOLCOMMIT)"
-
-# RUN echo $HOLCOMMIT
-
-# Download HOL4 and compile
-RUN git clone https://github.com/HOL-Theorem-Prover/HOL.git HOL4 && \
-    cd HOL4 && \
-    git checkout `cat /root/HOLCOMMIT` &&\
-    git rev-parse HEAD &&\
-    poly < tools/smart-configure.sml && \
-    ./bin/build
-
-RUN echo "HOLDIR=/root/HOL4" >> /root/.profile
-
-ENV HOLDIR /root/HOL4

coq/configure_coq.sh

@@ -25,7 +25,9 @@ fi
 coq_ver=$(${COQBIN}coqc -v 2>/dev/null | sed -n -e 's/The Coq Proof Assistant, version \([^ ]*\).*$/\1/p')
 case "$coq_ver" in
     8.7.2)
-       ;;
+    ;;
+    8.8.0)
+    ;;
     *)
         echo "Error: Need 8.7.2"
         exit 1

coq/floverParser.v

@@ -12,8 +12,9 @@ Inductive Token:Type :=
 | DCOND
 | DGAMMA
 | DTYPE:mType -> Token
+| DFIXED
 | DVAR
-| DCONST: N -> Token
+| DCONST: nat -> Token
 | DNEG
 | DPLUS
 | DSUB
@@ -32,7 +33,7 @@ Definition getChar (input:string):=
   end.
 
 Definition getConst (c:ascii) :=
-  ((N_of_ascii c) - 48)%N.
+  ((nat_of_ascii c) - 48)%nat.
 
 Definition suffix (s:string) :=
 match s with
@@ -50,7 +51,7 @@ Definition isAlpha (c:ascii) :bool :=
 Definition isAlphaNum (c :ascii) :bool :=
   isDigit c || isAlpha c.
 
-Fixpoint lexConst (input:string) (akk:N) :=
+Fixpoint lexConst (input:string) (akk:nat) :=
   match input with
   |String c input' =>
    if (isDigit c)
@@ -97,10 +98,14 @@ match fuel with
                  | "GAMMA" => DGAMMA :: lex input'' fuel'
                  | "Var" => DVAR :: lex input'' fuel'
                  | "Cast" => DCAST :: lex input'' fuel'
+                 | "F" => DFIXED :: lex input'' fuel'
                  | "MTYPE" => let ts := lex input'' fuel' in
                               (match ts with
+                               |DCONST 16 :: ts' => DTYPE M16 :: ts'
                                |DCONST 32 :: ts' => DTYPE M32 :: ts'
                                |DCONST 64 :: ts' => DTYPE M64 :: ts'
+                               |DFIXED :: DCONST w :: DCONST f :: ts' =>
+                                DTYPE (F (Pos.of_nat w) (Pos.of_nat f)) :: ts'
                             (* | DCONST 128 :: ts' => DTYPE M128 :: ts' *)
                             (* | DCONST 256 :: ts' => DTYPE M256 :: ts' *)
                                | _ => []
@@ -154,9 +159,10 @@ Definition pp_token (token:Token) :=
   | DABS => "ABS"
   | DCOND => "?"
   | DVAR => "Var"
-  | DCONST num => str_of_num (N.to_nat num) (N.to_nat num)
+  | DCONST num => str_of_num num num
   | DGAMMA => "Gamma"
   | DTYPE m => str_join "MTYPE " (type_to_string m)
+  | DFIXED => ""
   | DNEG => "~"
   | DPLUS => "+"
   | DSUB => "-"
@@ -181,10 +187,10 @@ Fixpoint parseExp (tokList:list Token) (fuel:nat):option (expr Q * list Token) :
      match tokList with
      | DCONST n :: DFRAC :: DCONST m :: DTYPE t :: tokRest =>
        match m with
-       |N0 => None
-       |Npos p => Some (Const t (Z.of_N n # p), tokRest)
+       | 0%nat => None
+       |S p => Some (Const t (Z.of_nat n # (Pos.of_nat p)), tokRest)
        end
-     | DVAR :: DCONST n :: tokRest => Some (Var Q (N.to_nat n), tokRest)
+     | DVAR :: DCONST n :: tokRest => Some (Var Q n, tokRest)
      | DNEG :: tokRest =>
        match (parseExp tokRest fuel') with
        | Some (Const m c, tokRest) => Some (Const m (- c), tokRest)
@@ -259,7 +265,7 @@ Fixpoint parseLet input fuel:option (cmd Q * list Token) :=
                (* Parse it *)
                match (parseLet letBodyRest fuel') with
                (* And construct a result from it *)
-               | Some (letCmd, arbRest) => Some (Let m (N.to_nat n) e letCmd, arbRest)
+               | Some (letCmd, arbRest) => Some (Let m n e letCmd, arbRest)
                | _ => None
                end
              (* But if we have a return *)
@@ -267,7 +273,7 @@ Fixpoint parseLet input fuel:option (cmd Q * list Token) :=
                (* parse only this *)
                match (parseRet retBodyRest fuel) with
                (* and construct the result *)
-               | Some (retCmd, arbRest) => Some (Let m (N.to_nat n) e retCmd, arbRest)
+               | Some (retCmd, arbRest) => Some (Let m n e retCmd, arbRest)
                | _ => None
                end
              | _ => None (* fail if there is no continuation for the let *)
@@ -283,13 +289,13 @@ Definition parseFrac (input:list Token) :option (Q * list Token) :=
   match input with
   | DNEG :: DCONST n :: DFRAC :: DCONST m :: tokRest =>
     match m with
-    |N0 => None
-    |Npos p => Some ((- Z.of_N n # p),tokRest)
+    |0%nat => None
+    |S p => Some ((- Z.of_nat n # Pos.of_nat p),tokRest)
     end
   | DCONST n :: DFRAC :: DCONST m :: tokRest =>
     match m with
-    |N0 => None
-    |Npos p => Some ((Z.of_N n # p),tokRest)
+    |0%nat => None
+    |S p => Some ((Z.of_nat n # Pos.of_nat p),tokRest)
     end
   | _ => None
   end.
@@ -322,8 +328,8 @@ Fixpoint parsePrecondRec (input:list Token) (fuel:nat) :option (precond * list T
        match parseIV fracRest with
        | Some (iv, precondRest) =>
          match parsePrecondRec precondRest fuel' with
-         | Some (P, tokRest) => Some (updPre (N.to_nat n) iv P, tokRest)
-         | None => Some (updPre (N.to_nat n) iv defaultPre, precondRest)
+         | Some (P, tokRest) => Some (updPre n iv P, tokRest)
+         | None => Some (updPre n iv defaultPre, precondRest)
          end
        | _ => None
        end
@@ -386,7 +392,7 @@ Fixpoint parseGammaRec (input: list Token) : option ((nat -> option mType) * lis
   match input with
   | DVAR :: DCONST n :: DTYPE m :: inputRest =>
     match parseGammaRec inputRest with
-    | Some (Gamma, rest) => Some (updDefVars (N.to_nat n) m Gamma, rest)
+    | Some (Gamma, rest) => Some (updDefVars n m Gamma, rest)
     | None => None
      end
   | _  => Some (defaultGamma, input)
@@ -542,6 +548,6 @@ Fixpoint check_all (num_fun:nat) (iters:nat) (input:list Token) fuel:=
 Definition runChecker (input:string) :=
   let tokList := lex input (str_length input) in
   match tokList with
-  | DCONST n :: DCONST m :: tokRest => check_all (N.to_nat m) (N.to_nat n)  tokRest (List.length tokList * 100)
+  | DCONST n :: DCONST m :: tokRest => check_all m n tokRest (List.length tokList * 100)
   | _ => "failure no num of functions"
   end.

hol4/CertificateCheckerScript.sml

@@ -44,7 +44,7 @@ val Certificate_checking_is_sound = store_thm ("Certificate_checking_is_sound",
       CertificateChecker e A P defVars ==>
       ?iv err vR vF m.
         FloverMapTree_find e A = SOME (iv,err) /\
-        eval_exp E1 (toRMap defVars) (toREval e) vR M0 /\
+        eval_exp E1 (toRMap defVars) (toREval e) vR REAL /\
         eval_exp E2 defVars e vF m /\
         (!vF m.
            eval_exp E2 defVars e vF m ==>
@@ -99,7 +99,7 @@ val CertificateCmd_checking_is_sound = store_thm ("CertificateCmd_checking_is_so
       CertificateCheckerCmd f A P defVars ==>
       ?iv err vR vF m.
         FloverMapTree_find (getRetExp f) A = SOME (iv, err) /\
-        bstep (toREvalCmd f) E1 (toRMap defVars) vR M0 /\
+        bstep (toREvalCmd f) E1 (toRMap defVars) vR REAL /\
         bstep f E2 defVars vF m /\
         (!vF m. bstep f E2 defVars vF m ==> abs (vR - vF) <= err)``,
   simp [CertificateCheckerCmd_def]

hol4/CommandsScript.sml

@@ -20,7 +20,7 @@ val _ = Datatype `
 val toREvalCmd_def = Define `
   toREvalCmd (f:real cmd) : real cmd =
 	case f of
-	  | Let m x e g => Let M0 x (toREval e) (toREvalCmd g)
+	  | Let m x e g => Let REAL x (toREval e) (toREvalCmd g)
 	  | Ret e => Ret (toREval e)`;
 
 (**

hol4/EnvironmentsScript.sml

@@ -12,7 +12,7 @@ val (approxEnv_rules, approxEnv_ind, approxEnv_cases) = Hol_reln `
   (!(E1:env) (E2:env) (defVars: num -> mType option) (A:analysisResult) (fVars:num_set) (dVars:num_set) v1 v2 x.
       approxEnv E1 defVars A fVars dVars E2 /\
       (defVars x = SOME m) /\
-      (abs (v1 - v2) <= abs v1 * (mTypeToQ m)) /\
+      (abs (v1 - v2) <= computeError v1  m) /\
       (lookup x (union fVars dVars) = NONE) ==>
       approxEnv (updEnv x v1 E1) (updDefVars x m defVars) A (insert x () fVars) dVars (updEnv x v2 E2)) /\
   (!(E1:env) (E2:env) (defVars: num -> mType option) (A:analysisResult)
@@ -58,7 +58,7 @@ val approxEnv_fVar_bounded = store_thm (
       E2 x = SOME v2 /\
       x IN (domain fVars) /\
       Gamma x = SOME m ==>
-      abs (v - v2) <= (abs v) * (mTypeToQ m)``,
+      abs (v - v2) <= computeError v m``,
   rpt strip_tac
   \\ qspec_then
       `\E1 Gamma absenv fVars dVars E2.
@@ -67,7 +67,7 @@ val approxEnv_fVar_bounded = store_thm (
          E2 x = SOME v2 /\
          x IN (domain fVars) /\
          Gamma x = SOME m ==>
-         abs (v - v2) <= (abs v) * (mTypeToQ m)`
+         abs (v - v2) <= computeError v m`
       (fn thm => irule (SIMP_RULE std_ss [] thm))
       approxEnv_ind
   \\ rpt strip_tac

hol4/ExpressionsScript.sml

@@ -61,7 +61,7 @@ val evalFma_def = Define `
 
 val toREval_def = Define `
   (toREval (Var n) = Var n) /\
-  (toREval (Const m n) = Const M0 n) /\
+  (toREval (Const m n) = Const REAL n) /\
   (toREval (Unop u e1) = Unop u (toREval e1)) /\
   (toREval (Binop b e1 e2) = Binop b (toREval e1) (toREval e2)) /\
   (toREval (Fma e1 e2 e3) = Fma (toREval e1) (toREval e2) (toREval e3)) /\
@@ -71,7 +71,9 @@ val toREval_def = Define `
   Define a perturbation function to ease writing of basic definitions
 **)
 val perturb_def = Define `
-  perturb (r:real) (e:real) = r * (1 + e)`
+  perturb (rVal:real) (REAL) (delta:real) = rVal /\
+  perturb rVal (F w f) delta = rVal + delta /\
+  perturb rVal _ delta = rVal * (1 + delta)`;
 
 (**
 Define expression evaluation relation parametric by an "error" epsilon.
@@ -80,38 +82,38 @@ using a perturbation of the real valued computation by (1 + delta), where
 |delta| <= machine epsilon.
 **)
 val (eval_exp_rules, eval_exp_ind, eval_exp_cases) = Hol_reln `
-  (!E defVars m x v.
-     defVars x = SOME m /\
+  (!E Gamma m x v.
+     Gamma x = SOME m /\
      E x = SOME v ==>
-     eval_exp E defVars (Var x) v m) /\
-  (!E defVars m n delta.
-      abs delta <= (mTypeToQ m) ==>
-     eval_exp E defVars (Const m n) (perturb n delta) m) /\
-  (!E defVars m f1 v1.
-     eval_exp E defVars f1 v1 m ==>
-     eval_exp E defVars (Unop Neg f1) (evalUnop Neg v1) m) /\
-  (!E defVars m f1 v1 delta.
-     abs delta <= (mTypeToQ m) /\
-     (v1 <> 0) /\
-     eval_exp E defVars f1 v1 m ==>
-     eval_exp E defVars (Unop Inv f1) (perturb (evalUnop Inv v1) delta) m) /\
-  (!E defVars m m1 f1 v1 delta.
+     eval_exp E Gamma (Var x) v m) /\
+  (!E Gamma m n delta.
+      abs delta <= (mTypeToR m) ==>
+     eval_exp E Gamma (Const m n) (perturb n m delta) m) /\
+  (!E Gamma m f1 v1.
+     eval_exp E Gamma f1 v1 m ==>
+     eval_exp E Gamma (Unop Neg f1) (evalUnop Neg v1) m) /\
+  (!E Gamma m f1 v1 delta.
+     abs delta <= (mTypeToR m) /\
+     eval_exp E Gamma f1 v1 m /\
+     (v1 <> 0) ==>
+     eval_exp E Gamma (Unop Inv f1) (perturb (evalUnop Inv v1) m delta) m) /\
+  (!E Gamma m m1 f1 v1 delta.
      isMorePrecise m1 m /\
-     abs delta <= (mTypeToQ m) /\
-     eval_exp E defVars f1 v1 m1 ==>
-     eval_exp E defVars (Downcast m f1) (perturb v1 delta) m) /\
-  (!E defVars m1 m2 b f1 f2 v1 v2 delta.
-     abs delta <= (mTypeToQ (join m1 m2)) /\
-     eval_exp E defVars f1 v1 m1 /\
-     eval_exp E defVars f2 v2 m2 /\
+     abs delta <= (mTypeToR m) /\
+     eval_exp E Gamma f1 v1 m1 ==>
+     eval_exp E Gamma (Downcast m f1) (perturb v1 m delta) m) /\
+  (!E Gamma m1 m2 b f1 f2 v1 v2 delta.
+     abs delta <= (mTypeToR (join m1 m2)) /\
+     eval_exp E Gamma f1 v1 m1 /\
+     eval_exp E Gamma f2 v2 m2 /\
      ((b = Div) ==> (v2 <> 0)) ==>
-     eval_exp E defVars (Binop b f1 f2) (perturb (evalBinop b v1 v2) delta) (join m1 m2)) /\
-  (!E defVars m1 m2 m3 f1 f2 f3 v1 v2 v3 delta.
-     abs delta <= (mTypeToQ (join3 m1 m2 m3)) /\
-     eval_exp E defVars f1 v1 m1 /\
-     eval_exp E defVars f2 v2 m2 /\
-     eval_exp E defVars f3 v3 m3 ==>
-     eval_exp E defVars (Fma f1 f2 f3) (perturb (evalFma v1 v2 v3) delta) (join3 m1 m2 m3))`;
+     eval_exp E Gamma (Binop b f1 f2) (perturb (evalBinop b v1 v2) (join m1 m2) delta) (join m1 m2)) /\
+  (!E Gamma m1 m2 m3 f1 f2 f3 v1 v2 v3 delta.
+     abs delta <= (mTypeToR (join3 m1 m2 m3)) /\
+     eval_exp E Gamma f1 v1 m1 /\
+     eval_exp E Gamma f2 v2 m2 /\
+     eval_exp E Gamma f3 v3 m3 ==>
+     eval_exp E Gamma (Fma f1 f2 f3) (perturb (evalFma v1 v2 v3) (join3 m1 m2 m3) delta) (join3 m1 m2 m3))`;
 
 val eval_exp_cases_old = save_thm ("eval_exp_cases_old", eval_exp_cases);
 
@@ -144,8 +146,8 @@ save_thm ("Downcast_dist", Downcast_dist);
 val Const_dist' = store_thm (
   "Const_dist'",
   ``!m n delta v m' E Gamma.
-      (abs delta) <= (mTypeToQ m) /\
-      v = perturb n delta /\
+      (abs delta) <= (mTypeToR m) /\
+      v = perturb n m delta /\
       m' = m ==>
       eval_exp E Gamma (Const m n) v m'``,
   fs [Const_dist]);
@@ -162,10 +164,10 @@ val Unop_neg' = store_thm (
 val Unop_inv' = store_thm (
   "Unop_inv'",
   ``!m f1 v1 delta v m' E Gamma.
-      (abs delta) <= (mTypeToQ m) /\
+      (abs delta) <= (mTypeToR m) /\
       eval_exp E Gamma f1 v1 m /\
       (v1 <> 0) /\
-      v = perturb (evalUnop Inv v1) delta /\
+      v = perturb (evalUnop Inv v1) m delta /\
       m' = m ==>
       eval_exp E Gamma (Unop Inv f1) v m'``,
   fs [Unop_inv]);
@@ -173,9 +175,9 @@ val Unop_inv' = store_thm (
 val Downcast_dist' = store_thm ("Downcast_dist'",
   ``!m m1 f1 v1 delta v m' E Gamma.
       isMorePrecise m1 m /\
-      (abs delta) <= (mTypeToQ m) /\
+      (abs delta) <= (mTypeToR m) /\
       eval_exp E Gamma f1 v1 m1 /\
-      v = perturb v1 delta /\
+      v = perturb v1 m delta /\
       m' = m ==>
       eval_exp E Gamma (Downcast m f1) v m'``,
   rpt strip_tac
@@ -185,22 +187,22 @@ val Downcast_dist' = store_thm ("Downcast_dist'",
 
 val Binop_dist' = store_thm ("Binop_dist'",
   ``!m1 m2 op f1 f2 v1 v2 delta v m' E Gamma.
-      (abs delta) <= (mTypeToQ m') /\
+      (abs delta) <= (mTypeToR m') /\
       eval_exp E Gamma f1 v1 m1 /\
       eval_exp E Gamma f2 v2 m2 /\
       ((op = Div) ==> (v2 <> 0)) /\
-      v = perturb (evalBinop op v1 v2) delta /\
+      v = perturb (evalBinop op v1 v2) m' delta /\
       m' = join m1 m2 ==>
       eval_exp E Gamma (Binop op f1 f2) v m'``,
   fs [Binop_dist]);
 
 val Fma_dist' = store_thm ("Fma_dist'",
   ``!m1 m2 m3 f1 f2 f3 v1 v2 v3 delta v m' E Gamma.
-      (abs delta) <= (mTypeToQ m') /\
+      (abs delta) <= (mTypeToR m') /\
       eval_exp E Gamma f1 v1 m1 /\
       eval_exp E Gamma f2 v2 m2 /\
       eval_exp E Gamma f3 v3 m3 /\
-      v = perturb (evalFma v1 v2 v3) delta /\
+      v = perturb (evalFma v1 v2 v3) m' delta /\
       m' = join3 m1 m2 m3 ==>
       eval_exp E Gamma (Fma f1 f2 f3) v m'``,
   fs [Fma_dist]);
@@ -222,35 +224,40 @@ val usedVars_def = Define `
 (**
   If |delta| <= 0 then perturb v delta is exactly v.
 **)
-val delta_0_deterministic = store_thm("delta_0_deterministic",
-  ``!(v:real) (delta:real). abs delta <= 0 ==> perturb v delta = v``,
+val delta_0_deterministic = store_thm(
+  "delta_0_deterministic",
+  ``!(v:real) (m:mType) (delta:real).
+      abs delta <= 0 ==> perturb v m delta = v``,
+  Cases_on `m` \\
   fs [perturb_def,ABS_BOUNDS,REAL_LE_ANTISYM]);
 
-val delta_M0_deterministic = store_thm("delta_M0_deterministic",
-  ``!(v:real) (delta:real). abs delta <= mTypeToQ M0 ==> perturb v delta = v``,
-  fs [mTypeToQ_def,perturb_def,ABS_BOUNDS,REAL_LE_ANTISYM]);
+val delta_REAL_deterministic = store_thm(
+  "delta_REAL_deterministic",
+  ``!(v:real) (m:mType) (delta:real).
+      abs delta <= mTypeToR REAL ==> perturb v m delta = v``,
+  Cases_on `m` \\ fs[mTypeToR_def, delta_0_deterministic]);
 
 val toRMap_def = Define `
   toRMap (d:num -> mType option) (n:num) : mType option =
     case d n of
-      | SOME m => SOME M0
+      | SOME m => SOME REAL
       | NONE => NONE`;
 
-val toRMap_eval_M0 = store_thm (
-  "toRMap_eval_M0",
+val toRMap_eval_REAL = store_thm (
+  "toRMap_eval_REAL",
   ``!f v E Gamma m.
-      eval_exp E (toRMap Gamma) (toREval f) v m ==> m = M0``,
+      eval_exp E (toRMap Gamma) (toREval f) v m ==> m = REAL``,
   Induct \\ fs[toREval_def] \\ fs[eval_exp_cases, toRMap_def]
   \\ rpt strip_tac \\ fs[]
   >- (every_case_tac \\ fs[])
   >- (rveq \\ first_x_assum drule \\ strip_tac \\ fs[])
   >- (rveq \\ first_x_assum drule \\ strip_tac \\ fs[])
-  >- (`m1 = M0` by (rpt (first_x_assum drule \\ strip_tac) \\ fs[])
-      \\ `m2 = M0` by (rpt (first_x_assum drule \\ strip_tac) \\ fs[])
+  >- (`m1 = REAL` by (rpt (first_x_assum drule \\ strip_tac) \\ fs[])
+      \\ `m2 = REAL` by (rpt (first_x_assum drule \\ strip_tac) \\ fs[])
       \\ rveq \\ fs[join_def])
-  >- (`m1 = M0` by (rpt (first_x_assum drule \\ strip_tac) \\ fs[])
-      \\ `m2 = M0` by (rpt (first_x_assum drule \\ strip_tac) \\ fs[])
-      \\ `m3 = M0` by (rpt (first_x_assum drule \\ strip_tac) \\ fs[])
+  >- (`m1 = REAL` by (rpt (first_x_assum drule \\ strip_tac) \\ fs[])
+      \\ `m2 = REAL` by (rpt (first_x_assum drule \\ strip_tac) \\ fs[])
+      \\ `m3 = REAL` by (rpt (first_x_assum drule \\ strip_tac) \\ fs[])
       \\ rveq \\ fs[join3_def] \\ fs[join_def]));
 
 (**
@@ -258,13 +265,13 @@ Evaluation with 0 as machine epsilon is deterministic
 **)
 val meps_0_deterministic = store_thm("meps_0_deterministic",
   ``!(f: real exp) v1:real v2:real E defVars.
-      eval_exp E (toRMap defVars) (toREval f) v1 M0 /\
-      eval_exp E (toRMap defVars) (toREval f) v2 M0 ==>
+      eval_exp E (toRMap defVars) (toREval f) v1 REAL /\
+      eval_exp E (toRMap defVars) (toREval f) v2 REAL ==>
       v1 = v2``,
   Induct_on `f`
   >- (rw [toREval_def] \\ fs [eval_exp_cases])
   >- (rw [toREval_def]
-      \\ fs [eval_exp_cases, mTypeToQ_def, delta_0_deterministic])
+      \\ fs [eval_exp_cases, mTypeToR_def, delta_0_deterministic])
   >- (rw []
       \\ rpt (
            qpat_x_assum `eval_exp _ _ (toREval _) _ _`
@@ -272,22 +279,22 @@ val meps_0_deterministic = store_thm("meps_0_deterministic",
       \\ Cases_on `u` \\ fs [eval_exp_cases] \\ rw []
       \\ fs [eval_exp_cases]
       >- (res_tac \\ fs [REAL_NEG_EQ])
-      >- (res_tac \\ fs [mTypeToQ_def, delta_0_deterministic]))
+      >- (res_tac \\ fs [mTypeToR_def, delta_0_deterministic]))
   >- (rw[]
       \\ rename1 `Binop b f1 f2`
       \\ rpt (
            qpat_x_assum `eval_exp _ _ (toREval _) _ _`
             (fn thm => assume_tac (ONCE_REWRITE_RULE [toREval_def] thm)))
       \\ Cases_on `b` \\ fs [eval_exp_cases]
-      \\ `m1 = M0 /\ m2 = M0` by (conj_tac \\ irule  toRMap_eval_M0 \\ asm_exists_tac \\ fs [])
+      \\ `m1 = REAL /\ m2 = REAL` by (conj_tac \\ irule  toRMap_eval_REAL \\ asm_exists_tac \\ fs [])
       \\ rw[]
-      \\ rename1 `eval_exp E _ (toREval f1) vf11 M0`
+      \\ rename1 `eval_exp E _ (toREval f1) vf11 REAL`
       \\ rename1 `eval_exp E _ (toREval f1) vf12 m1`
-      \\ rename1 `eval_exp E _ (toREval f2) vf21 M0`
+      \\ rename1 `eval_exp E _ (toREval f2) vf21 REAL`
       \\ rename1 `eval_exp _ _ (toREval f2) vf22 m2`
-      \\ `m1 = M0 /\ m2 = M0` by (conj_tac \\ irule toRMap_eval_M0 \\ asm_exists_tac \\  fs [])
+      \\ `m1 = REAL /\ m2 = REAL` by (conj_tac \\ irule toRMap_eval_REAL \\ asm_exists_tac \\  fs [])
       \\ rw []
-      \\ fs [join_def, mTypeToQ_def, delta_0_deterministic]
+      \\ fs [join_def, mTypeToR_def, delta_0_deterministic]
       \\ qpat_x_assum `!v1 v2 E defVars. _ /\ _ ==> v1 = v2` (fn thm =>qspecl_then [`vf21`,`vf22`] ASSUME_TAC thm)
       \\ qpat_x_assum `!v1 v2 E defVars. _ /\ _ ==> v1 = v2` (fn thm =>qspecl_then [`vf11`,`vf12`] ASSUME_TAC thm)
       \\ res_tac
@@ -297,15 +304,15 @@ val meps_0_deterministic = store_thm("meps_0_deterministic",
            qpat_x_assum `eval_exp _ _ (toREval _) _ _`
             (fn thm => assume_tac (ONCE_REWRITE_RULE [toREval_def] thm)))
       \\ fs [eval_exp_cases]
-      \\ `m1 = M0 /\ m2 = M0` by (conj_tac \\ irule  toRMap_eval_M0 \\ asm_exists_tac \\ fs [])
-      \\ `m3 = M0` by (irule  toRMap_eval_M0 \\ asm_exists_tac \\ fs [])
-      \\ `m1' = M0 /\ m2' = M0` by (conj_tac \\ irule  toRMap_eval_M0 \\ asm_exists_tac \\ fs [])
-      \\ `m3' = M0` by (irule  toRMap_eval_M0 \\ asm_exists_tac \\ fs [])
+      \\ `m1 = REAL /\ m2 = REAL` by (conj_tac \\ irule  toRMap_eval_REAL \\ asm_exists_tac \\ fs [])
+      \\ `m3 = REAL` by (irule  toRMap_eval_REAL \\ asm_exists_tac \\ fs [])
+      \\ `m1' = REAL /\ m2' = REAL` by (conj_tac \\ irule  toRMap_eval_REAL \\ asm_exists_tac \\ fs [])
+      \\ `m3' = REAL` by (irule  toRMap_eval_REAL \\ asm_exists_tac \\ fs [])
       \\ rw[]
       \\ qpat_x_assum `!v1 v2 E defVars. _ /\ _ ==> v1 = v2` (fn thm =>qspecl_then [`v3`,`v3'`, `E`, `defVars`] ASSUME_TAC thm)
       \\ qpat_x_assum `!v1 v2 E defVars. _ /\ _ ==> v1 = v2` (fn thm =>qspecl_then [`v2'`,`v2''`, `E`, `defVars`] ASSUME_TAC thm)
       \\ qpat_x_assum `!v1 v2 E defVars. _ /\ _ ==> v1 = v2` (fn thm =>qspecl_then [`v1'`,`v1''`, `E`, `defVars`] ASSUME_TAC thm)
-      \\ fs [join3_def, join_def, mTypeToQ_def, delta_0_deterministic])
+      \\ fs [join3_def, join_def, mTypeToR_def, delta_0_deterministic])
   >- (rw[]
       \\ rpt (
            qpat_x_assum `eval_exp _ _ (toREval (Downcast _ _)) _ _`
@@ -322,26 +329,26 @@ variables in the Environment.
 val binary_unfolding = store_thm("binary_unfolding",
   ``!(b:binop) (f1:(real)exp) (f2:(real)exp) E Gamma (v:real) v1 v2 m1 m2 delta.
       (b = Div ==> (v2 <> 0)) /\
-      (abs delta) <= (mTypeToQ (join m1 m2)) /\
+      (abs delta) <= (mTypeToR (join m1 m2)) /\
       eval_exp E Gamma f1 v1 m1 /\
       eval_exp E Gamma f2 v2 m2 /\
-      eval_exp E Gamma (Binop b f1 f2) (perturb (evalBinop b v1 v2) delta) (join m1 m2) ==>
+      eval_exp E Gamma (Binop b f1 f2) (perturb (evalBinop b v1 v2) (join m1 m2) delta) (join m1 m2) ==>
       eval_exp (updEnv 2 v2 (updEnv 1 v1 emptyEnv))
         (updDefVars 2 m2 (updDefVars 1 m1 Gamma))
-        (Binop b (Var 1) (Var 2)) (perturb (evalBinop b v1 v2) delta) (join m1 m2)``,
+        (Binop b (Var 1) (Var 2)) (perturb (evalBinop b v1 v2) (join m1 m2) delta) (join m1 m2)``,
   fs [updEnv_def,updDefVars_def,join_def,eval_exp_cases,APPLY_UPDATE_THM,PULL_EXISTS]
   \\ metis_tac []);
 
 val fma_unfolding = store_thm("fma_unfolding",
   ``!(f1:(real)exp) (f2:(real)exp) (f3:(real)exp) E Gamma (v:real) v1 v2 v3 m1 m2 m3 delta.
-      (abs delta) <= (mTypeToQ (join3 m1 m2 m3)) /\
+      (abs delta) <= (mTypeToR (join3 m1 m2 m3)) /\
       eval_exp E Gamma f1 v1 m1 /\
       eval_exp E Gamma f2 v2 m2 /\
       eval_exp E Gamma f3 v3 m3 /\
-      eval_exp E Gamma (Fma f1 f2 f3) (perturb (evalFma v1 v2 v3) delta) (join3 m1 m2 m3) ==>
+      eval_exp E Gamma (Fma f1 f2 f3) (perturb (evalFma v1 v2 v3) (join3 m1 m2 m3) delta) (join3 m1 m2 m3) ==>
       eval_exp (updEnv 3 v3 (updEnv 2 v2 (updEnv 1 v1 emptyEnv)))
         (updDefVars 3 m3 (updDefVars 2 m2 (updDefVars 1 m1 Gamma)))
-        (Fma (Var 1) (Var 2) (Var 3)) (perturb (evalFma v1 v2 v3) delta) (join3 m1 m2 m3)``,
+        (Fma (Var 1) (Var 2) (Var 3)) (perturb (evalFma v1 v2 v3) (join3 m1 m2 m3) delta) (join3 m1 m2 m3)``,
   fs [updEnv_def,updDefVars_def,join3_def,join_def,eval_exp_cases,APPLY_UPDATE_THM,PULL_EXISTS]
   \\ rpt strip_tac
   \\ qexists_tac `delta'`

hol4/FPRangeValidatorScript.sml

@@ -150,7 +150,7 @@ val FPRangeValidator_sound = store_thm (
           \\ disch_then drule \\ fs[])
   \\ once_rewrite_tac [validFloatValue_def]
   \\ `?iv err vR. FloverMapTree_find e A = SOME (iv, err) /\
-        eval_exp E1 (toRMap Gamma) (toREval e) vR M0 /\
+        eval_exp E1 (toRMap Gamma) (toREval e) vR REAL /\
         FST iv <= vR /\ vR <= SND iv`
        by (drule validIntervalbounds_sound
            \\ disch_then (qspecl_then [`fVars`, `E1`, `Gamma`] impl_subgoal_tac)
@@ -256,7 +256,7 @@ val FPRangeValidatorCmd_sound = store_thm (
                \\ rpt strip_tac
                \\ metis_tac[])
            >- (irule swap_Gamma_bstep
-               \\ qexists_tac `updDefVars n M0 (toRMap Gamma)` \\ fs[]
+               \\ qexists_tac `updDefVars n REAL (toRMap Gamma)` \\ fs[]
                \\ fs [updDefVars_def, REWRITE_RULE [updDefVars_def] Rmap_updVars_comm])
            >- (fs[DIFF_DEF, domain_insert, SUBSET_DEF]
                \\ rpt strip_tac \\ first_x_assum irule

hol4/IEEE_connectionScript.sml

@@ -51,7 +51,7 @@ val bstep_float_def = Define `
 
 val normal_or_zero_def = Define `
   normal_or_zero (v:real) =
-    (minValue M64 <= abs v \/ v = 0)`;