diff options
| author | Guillaume Bertholon | 2018-07-13 16:22:35 +0200 |
|---|---|---|
| committer | Pierre Roux | 2019-11-01 10:20:03 +0100 |
| commit | b0b3cc67e01b165272588b2d8bc178840ba83945 (patch) | |
| tree | 0fc62f69eb0b56a3cae6dd81f82ca869dac6fbc9 /interp/notation_ops.ml | |
| parent | f93684a412f067622a5026c406bc76032c30b6e9 (diff) | |
Add primitive float computation in Coq kernel
Beware of 0. = -0. issue for primitive floats
The IEEE 754 declares that 0. and -0. are treated equal but we cannot
say that this is true with Leibniz equality.
Therefore we must patch the equality and the total comparison inside the
kernel to prevent inconsistency.
Diffstat (limited to 'interp/notation_ops.ml')
| -rw-r--r-- | interp/notation_ops.ml | 10 |
1 files changed, 8 insertions, 2 deletions
diff --git a/interp/notation_ops.ml b/interp/notation_ops.ml index f30a874426..7e146754b2 100644 --- a/interp/notation_ops.ml +++ b/interp/notation_ops.ml @@ -90,9 +90,11 @@ let rec eq_notation_constr (vars1,vars2 as vars) t1 t2 = match t1, t2 with (eq_notation_constr vars) t1 t2 && cast_type_eq (eq_notation_constr vars) c1 c2 | NInt i1, NInt i2 -> Uint63.equal i1 i2 +| NFloat f1, NFloat f2 -> + Float64.equal f1 f2 | (NRef _ | NVar _ | NApp _ | NHole _ | NList _ | NLambda _ | NProd _ | NBinderList _ | NLetIn _ | NCases _ | NLetTuple _ | NIf _ - | NRec _ | NSort _ | NCast _ | NInt _), _ -> false + | NRec _ | NSort _ | NCast _ | NInt _ | NFloat _), _ -> false (**********************************************************************) (* Re-interpret a notation as a glob_constr, taking care of binders *) @@ -222,6 +224,7 @@ let glob_constr_of_notation_constr_with_binders ?loc g f e nc = | NHole (x, naming, arg) -> GHole (x, naming, arg) | NRef x -> GRef (x,None) | NInt i -> GInt i + | NFloat f -> GFloat f let glob_constr_of_notation_constr ?loc x = let rec aux () x = @@ -438,6 +441,7 @@ let notation_constr_and_vars_of_glob_constr recvars a = | GCast (c,k) -> NCast (aux c,map_cast_type aux k) | GSort s -> NSort s | GInt i -> NInt i + | GFloat f -> NFloat f | GHole (w,naming,arg) -> if arg != None then has_ltac := true; NHole (w, naming, arg) @@ -627,6 +631,7 @@ let rec subst_notation_constr subst bound raw = | NSort _ -> raw | NInt _ -> raw + | NFloat _ -> raw | NHole (knd, naming, solve) -> let nknd = match knd with @@ -1196,6 +1201,7 @@ let rec match_ inner u alp metas sigma a1 a2 = | GSort s1, NSort s2 when glob_sort_eq s1 s2 -> sigma | GInt i1, NInt i2 when Uint63.equal i1 i2 -> sigma + | GFloat f1, NFloat f2 when Float64.equal f1 f2 -> sigma | GPatVar _, NHole _ -> (*Don't hide Metas, they bind in ltac*) raise No_match | a, NHole _ -> sigma @@ -1223,7 +1229,7 @@ let rec match_ inner u alp metas sigma a1 a2 = | (GRef _ | GVar _ | GEvar _ | GPatVar _ | GApp _ | GLambda _ | GProd _ | GLetIn _ | GCases _ | GLetTuple _ | GIf _ | GRec _ | GSort _ | GHole _ - | GCast _ | GInt _ ), _ -> raise No_match + | GCast _ | GInt _ | GFloat _), _ -> raise No_match and match_in u = match_ true u |