From b00a4537d8b8ef0203bec789d8bf79d3795676b1 Mon Sep 17 00:00:00 2001 From: Ryan Scott Date: Tue, 4 Aug 2026 12:57:40 -0400 Subject: [PATCH 1/3] Whitespace only --- saw-core-aig/src/SAWCoreAIG/BitBlast.hs | 2 +- saw-core-what4/src/SAWCoreWhat4/Uninterp.hs | 22 ++++++++++----------- saw-core/src/SAWCore/SharedTerm.hs | 6 +++--- 3 files changed, 15 insertions(+), 15 deletions(-) diff --git a/saw-core-aig/src/SAWCoreAIG/BitBlast.hs b/saw-core-aig/src/SAWCoreAIG/BitBlast.hs index f565e0c1e8..281c594eca 100644 --- a/saw-core-aig/src/SAWCoreAIG/BitBlast.hs +++ b/saw-core-aig/src/SAWCoreAIG/BitBlast.hs @@ -352,7 +352,7 @@ sbvToIntOp g = intToBvOp :: AIG.IsAIG l g => g s -> BPrim (l s) intToBvOp g = Prims.natFun $ \n -> - Prims.intFun $ \x -> Prims.Prim + Prims.intFun $ \x -> Prims.Prim (VWord <$> if n >= 0 then return (AIG.bvFromInteger g (fromIntegral n) x) else AIG.neg g (AIG.bvFromInteger g (fromIntegral n) (negate x))) diff --git a/saw-core-what4/src/SAWCoreWhat4/Uninterp.hs b/saw-core-what4/src/SAWCoreWhat4/Uninterp.hs index 82a8198e67..7fc478942f 100644 --- a/saw-core-what4/src/SAWCoreWhat4/Uninterp.hs +++ b/saw-core-what4/src/SAWCoreWhat4/Uninterp.hs @@ -35,7 +35,7 @@ we'd end up with: g_0 a0 .. a1023 g_1 a0 .. a1023 .. - g_1023 a0 .. a1023 + g_1023 a0 .. a1023 Note that this has 1024 * 1024 terms. With the array translation, we should end up with: @@ -62,7 +62,7 @@ new uninterpreted symbols, but reuse the old ones. This is not an optimization, but is crucial for the correct behavior of the algorithm. The `UnintApp` type is used to collect the arguments to a function, and also -compute the root name for the function. For ordinary (non-dependent) +compute the root name for the function. For ordinary (non-dependent) function applications we just collect the arguments in the `UnintApp`. However, for dependent applications (e.g., to handle a size polymorphic function), we instead modify the root name of the function. This means that different @@ -213,7 +213,7 @@ data ReturnTrip sym = -- ^ We should reinterpret terms back into SAW Core. -- The boolean flag indicates that this is a symbolic variable -- (instead of constant), which has special handling without arguments. - + withSym :: IsSymExprBuilder sym => ReturnTrip sym -> (sym -> a) -> a withSym xs k = case xs of @@ -272,7 +272,7 @@ parseUninterpretedTop rt@(DoReturnTrip _ True _ _ _) ref app@(UnintApp _ _ argTy case testEquality Ctx.empty argTys of Just Refl -> evalStateT (parseUninterpreted' rt ref app ty) MapF.empty Nothing -> fail "At present, we do not support symbolic variables with parameters" - + parseUninterpretedTop saw ref app ty = do count <- @@ -295,10 +295,10 @@ parseUninterpretedTop saw ref app ty = _ -> pure (UninterpMany ixW elTy (V.fromList terms)) pure val - + -- | Track how many uninterpreted results we need for each base type. -newtype UnintCount (tc :: BaseType) = UnintCount Natural +newtype UnintCount (tc :: BaseType) = UnintCount Natural -- | Count how many uninterpreted symbols we need to represent a value -- of the given type. Note that this function should match exactly what @@ -458,7 +458,7 @@ parseUninterpreted' saw ref app ty = do -- See: -- https://github.com/GaloisInc/saw-script/issues/3206 - -- https://github.com/GaloisInc/what4/issues/364 + -- https://github.com/GaloisInc/what4/issues/364 -- Note that the `bad` would only matter if we use a rational in the -- result of an uninterpreted function, and we need to import the -- resulting What4 term back into What4 @@ -482,11 +482,11 @@ parseUninterpreted' saw ref app ty = elTy <- lift (termOfTValue sc et) V.generateM (fromIntegral n) (\i -> do - let newArg = ArgTermAt n elTy arg (fromIntegral i) + let newArg = ArgTermAt n elTy arg (fromIntegral i) el <- parseUninterpreted' (DoReturnTrip sym isVar st sc newArg) ref app et pure (ready el) ) - + VArrayType ity ety | Just (Some idx_repr) <- valueAsBaseType ity , Just (Some elm_repr) <- valueAsBaseType ety @@ -525,7 +525,7 @@ parseUninterpreted' saw ref app ty = Nothing | DoReturnTrip sym True st sc arg <- saw -> lift (bindSAWTerm sym st tyr =<< reconstructArgTerm arg sc []) - + Just (Arr fn w (x : xs) atms) -> do let newTerm = @@ -621,7 +621,7 @@ applyUnintApp sym app0 v = -------------------------------------------------------------------------------- -- `ArgTerms` are used to remember the mappings between low-level symbolic --- terms and SAW core terms. +-- terms and SAW core terms. -- | An 'ArgTerm' is a description of how to reassemble a saw-core diff --git a/saw-core/src/SAWCore/SharedTerm.hs b/saw-core/src/SAWCore/SharedTerm.hs index a684fb2704..5b43ef3eb9 100644 --- a/saw-core/src/SAWCore/SharedTerm.hs +++ b/saw-core/src/SAWCore/SharedTerm.hs @@ -602,7 +602,7 @@ ppTermError :: SharedContext -> TermError -> IO Text ppTermError sc err = do ppopts <- scGetPPOpts sc err' <- prettyTermError sc err - pure $ PPS.renderText ppopts err' + pure $ PPS.renderText ppopts err' execSCM :: SharedContext -> SCM a -> IO a execSCM sc m = @@ -1016,7 +1016,7 @@ instance IsMetadata PrettyOpts where -- | Update the prettyprinter options. scModifyPPOpts :: SharedContext -> (PPS.Opts -> PPS.Opts) -> IO () -scModifyPPOpts sc f = scUpdateData sc $ \(PrettyOpts opts) -> +scModifyPPOpts sc f = scUpdateData sc $ \(PrettyOpts opts) -> PrettyOpts $ f opts -- | Get the current prettyprinter options @@ -1028,7 +1028,7 @@ scGetPPOpts sc = do -- | Wrap an operation in different prettyprinter options. scWithPPOpts :: SharedContext -> (PPS.Opts -> PPS.Opts) -> IO a -> IO a scWithPPOpts sc alter action = do - old <- scGetPPOpts sc + old <- scGetPPOpts sc scModifyPPOpts sc alter a <- action scModifyPPOpts sc (\_ -> old) From f070c4ec6a7885d8e49b46848965ed64c81ec628 Mon Sep 17 00:00:00 2001 From: Ryan Scott Date: Wed, 12 Aug 2026 08:04:47 -0400 Subject: [PATCH 2/3] otherTests/saw-core-rocq: Add *.rawlog to .gitignore --- otherTests/saw-core-rocq/.gitignore | 1 + 1 file changed, 1 insertion(+) diff --git a/otherTests/saw-core-rocq/.gitignore b/otherTests/saw-core-rocq/.gitignore index 73635c0bbd..6a33ac09c2 100644 --- a/otherTests/saw-core-rocq/.gitignore +++ b/otherTests/saw-core-rocq/.gitignore @@ -1,3 +1,4 @@ +*.rawlog *.log *.v *.log.diff From 6143453dfe94b5cf976eb32c62afa85e05156861 Mon Sep 17 00:00:00 2001 From: Ryan Scott Date: Fri, 20 Feb 2026 10:25:35 -0500 Subject: [PATCH 3/3] SAWCore Float support This adds basic support for Cryptol's `Float` type in SAWCore. At a glance, this involves the following: * Flesh out the floating-point primitives in the SAWCore prelude to cover all of the corresponding primitives in Cryptol's `Float.cry` module, as well as any additional primitives needed to support What4-related floating-point operations. Also add corresponding Cryptol-oriented functions to `cryptol-saw-core`'s `Cryptol.sawcore`. * Add `Float` support for the concrete and What4 backends. (Support in the AIG, RME, and SBV backends is left as future work.) * Add `saw-core-rocq` support for `Float` by building on top of the Flocq library in Rocq. One limitation of the current implementation is that certain partial operations do not enforce their preconditions properly (e.g., `fpToRational`'s precondition that the input is finite and non-NaN). In order to do this robustly, we will need to address #2433 first. Fixes #1237. --- .github/workflows/ci.yml | 6 +- CHANGES.md | 2 +- cryptol-saw-core/saw/Cryptol.sawcore | 399 +++++-- .../src/CryptolSAWCore/Cryptol.hs | 86 +- .../src/CryptolSAWCore/TypedTerm.hs | 1 + .../FloatPropertiesGeneric.cry | 860 +++++++++++++++ .../test1237_properties/GenFloatProperties.hs | 114 ++ intTests/test1237_properties/test.saw | 572 ++++++++++ intTests/test1237_properties/test.sh | 3 + intTests/test1237_unit_tests/test.saw | 131 +++ intTests/test1237_unit_tests/test.sh | 3 + .../test_cryptol_primitives_1.v.good | 975 +++++++++--------- .../saw-core-rocq/test_prelude_1.v.good | 162 ++- saw-central/src/SAWCentral/Prover/Exporter.hs | 10 +- saw-core-aig/src/SAWCoreAIG/BitBlast.hs | 37 + saw-core-rocq/README.md | 11 +- saw-core-rocq/rocq/_RocqProject | 2 + .../CryptolToRocq/IEEE754/BitsExtra.v | 52 + .../CryptolToRocq/IEEE754/BitsSingleNaN.v | 41 + .../CryptolToRocq/SAWCoreScaffolding.v | 237 +++++ .../SAWCoreVectorsAsRocqVectors.v | 97 ++ .../src/SAWCoreRocq/SpecialTreatment.hs | 44 +- saw-core-sbv/src/SAWCoreSBV/SBV.hs | 73 +- saw-core-sbv/src/SAWCoreSBV/SWord.hs | 16 +- saw-core-what4/src/SAWCoreWhat4/Common.hs | 6 + saw-core-what4/src/SAWCoreWhat4/FirstOrder.hs | 21 +- saw-core-what4/src/SAWCoreWhat4/ReturnTrip.hs | 222 +++- saw-core-what4/src/SAWCoreWhat4/Uninterp.hs | 18 + saw-core-what4/src/SAWCoreWhat4/What4.hs | 129 ++- saw-core/prelude/Prelude.sawcore | 197 +++- saw-core/src/SAWCore/Fingerprint.hs | 1 + saw-core/src/SAWCore/FiniteValue.hs | 55 + saw-core/src/SAWCore/FloatHelpers.hs | 206 ++++ saw-core/src/SAWCore/Prelude.hs | 8 + saw-core/src/SAWCore/Recognizer.hs | 4 + saw-core/src/SAWCore/SharedTerm.hs | 226 ++++ saw-core/src/SAWCore/Simulator/Concrete.hs | 142 +++ saw-core/src/SAWCore/Simulator/Prims.hs | 420 ++++++++ saw-core/src/SAWCore/Simulator/RME.hs | 37 + saw-core/src/SAWCore/Simulator/Value.hs | 22 + saw-core/src/SAWCore/Testing/Random.hs | 71 +- saw-server/src/SAWServer/ProofScript.hs | 1 + saw.cabal | 4 + 43 files changed, 5024 insertions(+), 700 deletions(-) create mode 100644 intTests/test1237_properties/FloatPropertiesGeneric.cry create mode 100644 intTests/test1237_properties/GenFloatProperties.hs create mode 100644 intTests/test1237_properties/test.saw create mode 100644 intTests/test1237_properties/test.sh create mode 100644 intTests/test1237_unit_tests/test.saw create mode 100644 intTests/test1237_unit_tests/test.sh create mode 100644 saw-core-rocq/rocq/handwritten/CryptolToRocq/IEEE754/BitsExtra.v create mode 100644 saw-core-rocq/rocq/handwritten/CryptolToRocq/IEEE754/BitsSingleNaN.v create mode 100644 saw-core/src/SAWCore/FloatHelpers.hs diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index f6491c0557..ed0943b2d8 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -611,12 +611,14 @@ jobs: - run: opam pin add -y rocq-prover 9.0.0 - run: opam install -y rocq-core=9.1.0 rocq-stdlib=9.0.0 - # Install coq-bits from source. FIXME: replace with compatible - # opam-released version when available. + # Install coq-bits and coq-flocq from source. + # FIXME: replace pinned versions with compatible opam-released versions + # when available. - working-directory: saw-core-rocq/rocq run: | opam install -y coq=9.1.0 # coq-* packages include compatibility shims (e.g., coq_makefile). opam pin -y coq-bits https://github.com/rocq-community/bits.git#f50fc3e5f1eabcb0b0b94c8d25f75e61a255c2ba + opam pin -y coq-flocq https://gitlab.inria.fr/flocq/flocq.git#27143972fc1dc96e281626d5194b5b371f05db80 # FIXME: the following steps generate Rocq libraries for the SAWCore to # Rocq translator and builds them; if we do other Rocq tests, these steps diff --git a/CHANGES.md b/CHANGES.md index 60ce0fed74..e3e886cefb 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -59,7 +59,7 @@ This release supports [version corresponding to a source file and source line number, or (3) the unnamed Metadata at the requested index. -* Add basic support for Cryptol `Rational` values in SAWCore. +* Add basic support for Cryptol `Rational` and `Float` values in SAWCore. * Add support for derived Cryptol instances in SAWCore. diff --git a/cryptol-saw-core/saw/Cryptol.sawcore b/cryptol-saw-core/saw/Cryptol.sawcore index 1e2e56c61e..0bdc002fcb 100644 --- a/cryptol-saw-core/saw/Cryptol.sawcore +++ b/cryptol-saw-core/saw/Cryptol.sawcore @@ -629,6 +629,9 @@ PEqInteger = { eq = intEq }; PEqRational : PEq Rational; PEqRational = { eq = rationalEq }; +PEqFloat : (e p : Nat) -> PEq (Float e p); +PEqFloat e p = { eq = fpIeeeEq e p }; + PEqIntMod : (n : Nat) -> PEq (IntMod n); PEqIntMod n = { eq = intModEq n }; @@ -710,6 +713,14 @@ PCmpInteger = { cmpEq = PEqInteger, cmp = integerCmp, le = intLe, lt = intLt }; PCmpRational : PCmp Rational; PCmpRational = { cmpEq = PEqRational, cmp = rationalCmp, le = rationalLe, lt = rationalLt }; +PCmpFloat : (e p : Nat) -> PCmp (Float e p); +PCmpFloat e p = + { cmpEq = PEqFloat e p + , cmp = fpCmp e p + , le = fpLe e p + , lt = fpLt e p + }; + PCmpVec : (n : Nat) -> (a : isort 0) -> PCmp a -> PCmp (Vec n a); PCmpVec n a pa = { cmpEq = PEqVec n a pa.cmpEq @@ -945,6 +956,9 @@ PZeroIntMod n = toIntMod n (natToInt 0); PZeroRational : PZero Rational; PZeroRational = rationalZero; +PZeroFloat : (e p : Nat) -> PZero (Float e p); +PZeroFloat e p = fpPosZero e p; + PZeroIntModNum : (num : Num) -> PZero (IntModNum num); PZeroIntModNum num = Num#rec1 (\ (n : Num) -> PZero (IntModNum n)) PZeroIntMod PZeroInteger num; @@ -1113,6 +1127,16 @@ PRingRational = , int = integerToRational }; +PRingFloat : (e p : Nat) -> PRing (Float e p); +PRingFloat e p = + { ringZero = PZeroFloat e p + , add = fpAdd e p rne + , sub = fpSub e p rne + , mul = fpMul e p rne + , neg = fpNeg e p + , int = fpFromInteger e p rne + }; + PRingVec : (n : Nat) -> (a : isort 0) -> PRing a -> PRing (Vec n a); PRingVec n a pa = { ringZero = replicate n a pa.ringZero @@ -1272,6 +1296,12 @@ PFieldRational = , fieldDiv = rationalDiv }; +PFieldFloat : (e p : Nat) -> PField (Float e p); +PFieldFloat e p = + { fieldRing = PRingFloat e p + , recip = fpDiv e p rne (fpFromInteger e p rne (natToInt 1)) + , fieldDiv = fpDiv e p rne + }; PFieldIntMod : (n : Nat) -> PField (IntMod n); PFieldIntMod n = @@ -1311,6 +1341,16 @@ PRoundRational = , roundToEven = rationalRoundToEven }; +PRoundFloat : (e p : Nat) -> PRound (Float e p); +PRoundFloat e p = + { roundField = PFieldFloat e p + , roundCmp = PCmpFloat e p + , floor = fpToInteger e p rtn + , ceiling = fpToInteger e p rtp + , trunc = fpToInteger e p rtz + , roundAway = fpToInteger e p rna + , roundToEven = fpToInteger e p rne + }; -- Literal and LiteralLessThan classes @@ -1348,6 +1388,9 @@ PLiteralIntModNum num = PLiteralRational : PLiteral Rational; PLiteralRational = \ (x : Nat) -> integerToRational (natToInt x); +PLiteralFloat : (e p : Nat) -> PLiteral (Float e p); +PLiteralFloat e p = \ (x : Nat) -> fpFromInteger e p rne (natToInt x); + -- FLiteral class -- Compared to the Cryptol class 'FLiteral m n r a', we omit the 'm', 'n', and @@ -1362,6 +1405,10 @@ PFLiteralRational : PFLiteral Rational; PFLiteralRational = \ (m : Nat) (n : Nat) (r : Nat) -> ratio (natToInt m) (natToInt n); +PFLiteralFloat : (e p : Nat) -> PFLiteral (Float e p); +PFLiteralFloat e p = \ (m : Nat) (n : Nat) (r : Nat) -> + fpFromRational e p rne (ratio (natToInt m) (natToInt n)); + -------------------------------------------------------------------------------- -- Primitive Cryptol functions @@ -1959,121 +2006,247 @@ ecScanl n a b f z = n; -------------------------------------------------------------------------------- --- Floating point primitives (TODO) - -TCFloat : Num -> Num -> sort 0; -TCFloat _ _ = #(); - -PEqFloat : (e p : Num) -> PEq (TCFloat e p); -PEqFloat e p = { eq = \(x y : TCFloat e p) -> error Bool "Unimplemented: (==) Float" }; - -PCmpFloat : (e p : Num) -> PCmp (TCFloat e p); -PCmpFloat e p = - { cmpEq = PEqFloat e p - , cmp = \(x y : TCFloat e p) (k : Bool) -> error Bool "Unimplemented: Cmp Float" - , le = \(x y : TCFloat e p) -> error Bool "Unimplemented: Cmp Float" - , lt = \(x y : TCFloat e p) -> error Bool "Unimplemented: Cmp Float" - }; - -PZeroFloat : (e p : Num) -> PZero (TCFloat e p); -PZeroFloat e p = error (TCFloat e p) "Unimplemented: Zero Float"; - -PRingFloat : (e p : Num) -> PRing (TCFloat e p); -PRingFloat e p = - { ringZero = PZeroFloat e p - , add = \(x y : TCFloat e p) -> error (TCFloat e p) "Unimplemented: (+) Float" - , sub = \(x y : TCFloat e p) -> error (TCFloat e p) "Unimplemented: (-) Float" - , mul = \(x y : TCFloat e p) -> error (TCFloat e p) "Unimplemented: (*) Float" - , neg = \(x : TCFloat e p) -> error (TCFloat e p) "Unimplemented: neg Float" - , int = \ (i : Integer) -> error (TCFloat e p) "Unimplemented: toInteger Float" - }; - -PFieldFloat : (e p : Num) -> PField (TCFloat e p); -PFieldFloat e p = - { fieldRing = PRingFloat e p - , recip = \(x : TCFloat e p) -> error (TCFloat e p) "Unimplemented: recip Float" - , fieldDiv = \(x y : TCFloat e p) -> error (TCFloat e p) "Unimplemented: (/.) Float" - }; - -PRoundFloat : (e p : Num) -> PRound (TCFloat e p); -PRoundFloat e p = - { roundField = PFieldFloat e p - , roundCmp = PCmpFloat e p - , floor = \(x : TCFloat e p) -> error Integer "Unimplemented: floor Float" - , ceiling = \(x : TCFloat e p) -> error Integer "Unimplemented: ceiling Float" - , trunc = \(x : TCFloat e p) -> error Integer "Unimplemented: trunc Float" - , roundAway = \(x : TCFloat e p) -> error Integer "Unimplemented: roundAway Float" - , roundToEven = \(x : TCFloat e p) -> error Integer "Unimplemented: roundToEven Float" - }; - -PLiteralFloat : (e p : Num) -> PLiteral (TCFloat e p); -PLiteralFloat e p = \ (x : Nat) -> error (TCFloat e p) "Unimplemented: Literal Float"; - -PFLiteralFloat : (e p : Num) -> PFLiteral (TCFloat e p); -PFLiteralFloat _ _ = \ (m : Nat) (n : Nat) (r : Nat) -> (); - -ecFpNaN : (e : Num) -> (p : Num) -> TCFloat e p; -ecFpNaN e p = error (TCFloat e p) "Unimplemented: fpNaN"; - -ecFpPosInf : (e : Num) -> (p : Num) -> TCFloat e p; -ecFpPosInf e p = error (TCFloat e p) "Unimplemented: fpPosInf"; - -ecFpFromBits : (e : Num) -> (p : Num) -> seq (tcAdd e p) Bool -> TCFloat e p; -ecFpFromBits e p _ = error (TCFloat e p) "Unimplemented: fpFromBits"; - -ecFpToBits : (e : Num) -> (p : Num) -> TCFloat e p -> seq (tcAdd e p) Bool; -ecFpToBits e p _ = error (seq (tcAdd e p) Bool) "Unimplemented: fpToBits"; - -ecFpEq : (e : Num) -> (p : Num) -> TCFloat e p -> TCFloat e p -> Bool; -ecFpEq e p _ _ = error Bool "Unimplemented: =.="; - -ecFpAdd : (e : Num) -> (p : Num) -> Vec 3 Bool -> TCFloat e p -> TCFloat e p -> TCFloat e p; -ecFpAdd e p _ _ _ = error (TCFloat e p) "Unimplemented: fpAdd"; - -ecFpSub : (e : Num) -> (p : Num) -> Vec 3 Bool -> TCFloat e p -> TCFloat e p -> TCFloat e p; -ecFpSub e p _ _ _ = error (TCFloat e p) "Unimplemented: fpSub"; - -ecFpMul : (e : Num) -> (p : Num) -> Vec 3 Bool -> TCFloat e p -> TCFloat e p -> TCFloat e p; -ecFpMul e p _ _ _ = error (TCFloat e p) "Unimplemented: fpMul"; - -ecFpDiv : (e : Num) -> (p : Num) -> Vec 3 Bool -> TCFloat e p -> TCFloat e p -> TCFloat e p; -ecFpDiv e p _ _ _ = error (TCFloat e p) "Unimplemented: fpDiv"; +-- Floating point -ecFpToRational : (e : Num) -> (p : Num) -> TCFloat e p -> Rational; -ecFpToRational e p _ = error Rational "Unimplemented: fpToRational"; - -ecFpFromRational : (e : Num) -> (p : Num) -> Vec 3 Bool -> Rational -> TCFloat e p; -ecFpFromRational e p _ _ = error (TCFloat e p) "Unimplemented: fpFromRational"; - -fpIsNaN : (e : Num) -> (p : Num) -> TCFloat e p -> Bool; -fpIsNaN e p x = error Bool "Unimplemented: fpIsNaN"; - -fpIsInf : (e : Num) -> (p : Num) -> TCFloat e p -> Bool; -fpIsInf e p x = error Bool "Unimplemented: fpIsInf"; - -fpIsZero : (e : Num) -> (p : Num) -> TCFloat e p -> Bool; -fpIsZero e p x = error Bool "Unimplemented: fpIsZero"; - -fpIsNeg : (e : Num) -> (p : Num) -> TCFloat e p -> Bool; -fpIsNeg e p x = error Bool "Unimplemented: fpIsNeg"; - -fpIsNormal : (e : Num) -> (p : Num) -> TCFloat e p -> Bool; -fpIsNormal e p x = error Bool "Unimplemented: fpIsNormal"; - -fpIsSubnormal : (e : Num) -> (p : Num) -> TCFloat e p -> Bool; -fpIsSubnormal e p x = error Bool "Unimplemented: fpIsSubnormal"; - -fpFMA : - (e : Num) -> (p : Num) -> Vec 3 Bool -> - TCFloat e p -> TCFloat e p -> TCFloat e p -> TCFloat e p; -fpFMA e p r x y z = error (TCFloat e p) "Unimplemented: fpFMA"; - -fpAbs : (e : Num) -> (p : Num) -> TCFloat e p -> TCFloat e p; -fpAbs e p x = error (TCFloat e p) "Unimplemented: fpAbs"; - -fpSqrt : (e : Num) -> (p : Num) -> Vec 3 Bool -> TCFloat e p -> TCFloat e p; -fpSqrt e p r x = error (TCFloat e p) "Unimplemented: fpSqrt"; +-- Like the Float type, except that this takes Nums instead of Nats to +-- represent the exponent and precision (significand) bits. +-- +-- Note that in the case where one of the Nums is TCInf, we return a silly type +-- (e.g., Float 0 0). This is done such that we can define an Inhabited +-- instance for Float in saw-core-rocq (Flocq works such that even silly types +-- like Float 0 0 are inhabited). Note that most FloatNum operations will be +-- dispatched through floatNumFunction, which ensures that the number of +-- exponent and precision bits are finite, erroring out otherwise. +FloatNum : Num -> Num -> sort 0; +FloatNum e p = + Num#rec1 + (\ (_ : Num) -> sort 0) + (\ (e : Nat) -> + Num#rec1 + (\ (_ : Num) -> sort 0) + (Float e) + (Float e 0) + p) + (Float 0 0) + e; + +-- Create an inhabitant of the FloatNum type given a function that returns a +-- Float for all possible exponent and precision (significand) sizes. This is +-- only used for saw-core-rocq purposes (see Inhabited_FloatNum below). +FloatNumInhabited : (e p : Num) -> FloatNum e p; +FloatNumInhabited e p = + Num#rec1 + (\ (e : Num) -> FloatNum e p) + (\ (e : Nat) -> + Num#rec1 + (FloatNum (TCNum e)) + (fpPosZero e) + (fpPosZero e 0) + p) + (fpPosZero 0 0) + e; + +-- Define an Inhabited instance for FloatNum. This instance is crucial in order +-- to ensure that applications of floatNumFunction which use FloatNum in the +-- motive type will typecheck in Rocq. +injectCode "Rocq" + "#[global] Instance Inhabited_FloatNum (e p : Num) : Inhabited (FloatNum e p) := MkInhabited (FloatNum e p) (FloatNumInhabited e p)."; +FloatNum_cong : + (e : Num) -> (e' : Num) -> (p : Num) -> (p' : Num) -> + Eq Num e e' -> Eq Num p p' -> Eq (sort 0) (FloatNum e p) (FloatNum e' p'); +FloatNum_cong e e' p p' eq_e eq_p = + trans + (sort 0) (FloatNum e p) (FloatNum e' p) (FloatNum e' p') + (eq_cong Num e e' eq_e (sort 0) (\ (x : Num) -> FloatNum x p)) + (eq_cong Num p p' eq_p (sort 0) (\ (x : Num) -> FloatNum e' x)); + +-- An induction scheme on FloatNums that calls a function when the number of +-- exponent and precision bits are finite. If either of them are infinite, +-- this will error out. +floatNumFunction : + (motive : Num -> Num -> isort 0) -> + ((e p : Nat) -> motive (TCNum e) (TCNum p)) -> + (e p : Num) -> motive e p; +floatNumFunction motive f e p = + Num#rec1 + (\ (e : Num) -> motive e p) + (\ (e : Nat) -> + Num#rec1 + (\ (p : Num) -> motive (TCNum e) p) + (f e) + (error (motive (TCNum e) TCInf) "p should not be infinite") + p) + (error (motive TCInf p) "e should not be infinite") + e; + +ecFpNaN : (e : Num) -> (p : Num) -> FloatNum e p; +ecFpNaN = + floatNumFunction + FloatNum + fpNaN; + +ecFpPosInf : (e : Num) -> (p : Num) -> FloatNum e p; +ecFpPosInf = + floatNumFunction + FloatNum + fpPosInf; + +ecFpFromBits : (e : Num) -> (p : Num) -> seq (tcAdd e p) Bool -> FloatNum e p; +ecFpFromBits = + floatNumFunction + (\ (e p : Num) -> seq (tcAdd e p) Bool -> FloatNum e p) + fpFromBits; + +ecFpToBits : (e : Num) -> (p : Num) -> FloatNum e p -> seq (tcAdd e p) Bool; +ecFpToBits = + floatNumFunction + (\ (e p : Num) -> FloatNum e p -> seq (tcAdd e p) Bool) + fpToBits; + +ecFpLogicalEq : (e : Num) -> (p : Num) -> FloatNum e p -> FloatNum e p -> Bool; +ecFpLogicalEq = + floatNumFunction + (\ (e p : Num) -> FloatNum e p -> FloatNum e p -> Bool) + fpLogicalEq; + +ecFpAdd : (e : Num) -> (p : Num) -> RoundingMode -> FloatNum e p -> FloatNum e p -> FloatNum e p; +ecFpAdd = + floatNumFunction + (\ (e p : Num) -> RoundingMode -> FloatNum e p -> FloatNum e p -> FloatNum e p) + fpAdd; + +ecFpSub : (e : Num) -> (p : Num) -> RoundingMode -> FloatNum e p -> FloatNum e p -> FloatNum e p; +ecFpSub = + floatNumFunction + (\ (e p : Num) -> RoundingMode -> FloatNum e p -> FloatNum e p -> FloatNum e p) + fpSub; + +ecFpMul : (e : Num) -> (p : Num) -> RoundingMode -> FloatNum e p -> FloatNum e p -> FloatNum e p; +ecFpMul = + floatNumFunction + (\ (e p : Num) -> RoundingMode -> FloatNum e p -> FloatNum e p -> FloatNum e p) + fpMul; + +ecFpDiv : (e : Num) -> (p : Num) -> RoundingMode -> FloatNum e p -> FloatNum e p -> FloatNum e p; +ecFpDiv = + floatNumFunction + (\ (e p : Num) -> RoundingMode -> FloatNum e p -> FloatNum e p -> FloatNum e p) + fpDiv; + +ecFpToRational : (e : Num) -> (p : Num) -> FloatNum e p -> Rational; +ecFpToRational = + floatNumFunction + (\ (e p : Num) -> FloatNum e p -> Rational) + fpToRational; + +ecFpFromRational : (e : Num) -> (p : Num) -> RoundingMode -> Rational -> FloatNum e p; +ecFpFromRational = + floatNumFunction + (\ (e p : Num) -> RoundingMode -> Rational -> FloatNum e p) + fpFromRational; + +ecFpIsNaN : (e : Num) -> (p : Num) -> FloatNum e p -> Bool; +ecFpIsNaN = + floatNumFunction + (\ (e p : Num) -> FloatNum e p -> Bool) + fpIsNaN; + +ecFpIsInf : (e : Num) -> (p : Num) -> FloatNum e p -> Bool; +ecFpIsInf = + floatNumFunction + (\ (e p : Num) -> FloatNum e p -> Bool) + fpIsInf; + +ecFpIsZero : (e : Num) -> (p : Num) -> FloatNum e p -> Bool; +ecFpIsZero = + floatNumFunction + (\ (e p : Num) -> FloatNum e p -> Bool) + fpIsZero; + +ecFpIsNeg : (e : Num) -> (p : Num) -> FloatNum e p -> Bool; +ecFpIsNeg = + floatNumFunction + (\ (e p : Num) -> FloatNum e p -> Bool) + fpIsNeg; + +ecFpIsNormal : (e : Num) -> (p : Num) -> FloatNum e p -> Bool; +ecFpIsNormal = + floatNumFunction + (\ (e p : Num) -> FloatNum e p -> Bool) + fpIsNormal; + +ecFpIsSubnormal : (e : Num) -> (p : Num) -> FloatNum e p -> Bool; +ecFpIsSubnormal = + floatNumFunction + (\ (e p : Num) -> FloatNum e p -> Bool) + fpIsSubnormal; + +ecFpFMA : (e : Num) -> (p : Num) -> RoundingMode -> FloatNum e p -> FloatNum e p -> FloatNum e p -> FloatNum e p; +ecFpFMA = + floatNumFunction + (\ (e p : Num) -> RoundingMode -> FloatNum e p -> FloatNum e p -> FloatNum e p -> FloatNum e p) + fpFMA; + +ecFpAbs : (e : Num) -> (p : Num) -> FloatNum e p -> FloatNum e p; +ecFpAbs = + floatNumFunction + (\ (e p : Num) -> FloatNum e p -> FloatNum e p) + fpAbs; + +ecFpSqrt : (e : Num) -> (p : Num) -> RoundingMode -> FloatNum e p -> FloatNum e p; +ecFpSqrt = + floatNumFunction + (\ (e p : Num) -> RoundingMode -> FloatNum e p -> FloatNum e p) + fpSqrt; + +PEqFloatNum : (e p : Num) -> PEq (FloatNum e p); +PEqFloatNum = + floatNumFunction + (\ (e p : Num) -> PEq (FloatNum e p)) + PEqFloat; + +PCmpFloatNum : (e p : Num) -> PCmp (FloatNum e p); +PCmpFloatNum = + floatNumFunction + (\ (e p : Num) -> PCmp (FloatNum e p)) + PCmpFloat; + +PZeroFloatNum : (e p : Num) -> PZero (FloatNum e p); +PZeroFloatNum = + floatNumFunction + (\ (e p : Num) -> PZero (FloatNum e p)) + PZeroFloat; + +PRingFloatNum : (e p : Num) -> PRing (FloatNum e p); +PRingFloatNum = + floatNumFunction + (\ (e p : Num) -> PRing (FloatNum e p)) + PRingFloat; + +PFieldFloatNum : (e p : Num) -> PField (FloatNum e p); +PFieldFloatNum = + floatNumFunction + (\ (e p : Num) -> PField (FloatNum e p)) + PFieldFloat; + +PRoundFloatNum : (e p : Num) -> PRound (FloatNum e p); +PRoundFloatNum = + floatNumFunction + (\ (e p : Num) -> PRound (FloatNum e p)) + PRoundFloat; + +PLiteralFloatNum : (e p : Num) -> PLiteral (FloatNum e p); +PLiteralFloatNum = + floatNumFunction + (\ (e p : Num) -> PLiteral (FloatNum e p)) + PLiteralFloat; + +PFLiteralFloatNum : (e p : Num) -> PFLiteral (FloatNum e p); +PFLiteralFloatNum = + floatNumFunction + (\ (e p : Num) -> PFLiteral (FloatNum e p)) + PFLiteralFloat; -------------------------------------------------------------------------------- -- Extra primitives diff --git a/cryptol-saw-core/src/CryptolSAWCore/Cryptol.hs b/cryptol-saw-core/src/CryptolSAWCore/Cryptol.hs index 9dbdbdea87..f124bafdac 100644 --- a/cryptol-saw-core/src/CryptolSAWCore/Cryptol.hs +++ b/cryptol-saw-core/src/CryptolSAWCore/Cryptol.hs @@ -4,6 +4,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeApplications #-} {-# LANGUAGE ViewPatterns #-} {- | @@ -74,6 +75,7 @@ import Prettyprinter ((<+>)) -- cryptol import qualified Cryptol.Eval.Type as TV import qualified Cryptol.Backend as V +import qualified Cryptol.Backend.FloatHelpers as V import qualified Cryptol.Backend.Monad as V import qualified Cryptol.Backend.SeqMap as V import qualified Cryptol.Backend.WordValue as V @@ -103,6 +105,7 @@ import qualified Cryptol.ModuleSystem.Renamer as MR import qualified SAWSupport.Pretty as PPS -- saw-core +import SAWCore.FiniteValue (FirstOrderFloat(..)) import qualified SAWCore.Simulator.Concrete as SC import qualified SAWCore.Simulator.Value as SC import SAWCore.Prim (BitVector(..)) @@ -327,7 +330,7 @@ importType sc ty = do C.TCBit -> scBoolType sc C.TCInteger -> scIntegerType sc C.TCIntMod -> scGlobalApply sc "Cryptol.IntModNum" =<< traverse go tyargs - C.TCFloat -> scGlobalApply sc "Cryptol.TCFloat" =<< traverse go tyargs + C.TCFloat -> scGlobalApply sc "Cryptol.FloatNum" =<< traverse go tyargs C.TCArray -> do a <- go (tyargs !! 0) b <- go (tyargs !! 1) scArrayType sc a b @@ -523,7 +526,7 @@ provePropRec sc prop0 prop = do (C.pIsZero -> Just (C.tIsFloat -> Just (e, p))) -> do e' <- importType sc e p' <- importType sc p - scGlobalApply sc "Cryptol.PZeroFloat" [e', p'] + scGlobalApply sc "Cryptol.PZeroFloatNum" [e', p'] -- instance (Zero a) => Zero [n]a (C.pIsZero -> Just (C.tIsSeq -> Just (n, a))) -> do n' <- importType sc n @@ -606,7 +609,7 @@ provePropRec sc prop0 prop = do (C.pIsRing -> Just (C.tIsFloat -> Just (e, p))) -> do e' <- importType sc e p' <- importType sc p - scGlobalApply sc "Cryptol.PRingFloat" [e', p'] + scGlobalApply sc "Cryptol.PRingFloatNum" [e', p'] -- instance (Ring a) => Ring [n]a (C.pIsRing -> Just (C.tIsSeq -> Just (n, a))) -> do n' <- importType sc n @@ -658,7 +661,7 @@ provePropRec sc prop0 prop = do (C.pIsField -> Just (C.tIsFloat -> Just (e, p))) -> do e' <- importType sc e p' <- importType sc p - scGlobalApply sc "Cryptol.PFieldFloat" [e', p'] + scGlobalApply sc "Cryptol.PFieldFloatNum" [e', p'] -- instance Round Rational (C.pIsRound -> Just (C.tIsRational -> True)) @@ -667,7 +670,7 @@ provePropRec sc prop0 prop = do (C.pIsRound -> Just (C.tIsFloat -> Just (e, p))) -> do e' <- importType sc e p' <- importType sc p - scGlobalApply sc "Cryptol.PRoundFloat" [e', p'] + scGlobalApply sc "Cryptol.PRoundFloatNum" [e', p'] -- instance Eq Bit (C.pIsEq -> Just (C.tIsBit -> True)) @@ -686,7 +689,7 @@ provePropRec sc prop0 prop = do (C.pIsEq -> Just (C.tIsFloat -> Just (e, p))) -> do e' <- importType sc e p' <- importType sc p - scGlobalApply sc "Cryptol.PEqFloat" [e', p'] + scGlobalApply sc "Cryptol.PEqFloatNum" [e', p'] -- instance (fin n) => Eq [n] (C.pIsEq -> Just (C.tIsSeq -> Just (n, C.tIsBit -> True))) -> do n' <- importType sc n @@ -736,7 +739,7 @@ provePropRec sc prop0 prop = do (C.pIsCmp -> Just (C.tIsFloat -> Just (e, p))) -> do e' <- importType sc e p' <- importType sc p - scGlobalApply sc "Cryptol.PCmpFloat" [e', p'] + scGlobalApply sc "Cryptol.PCmpFloatNum" [e', p'] -- instance (fin n) => Cmp [n] (C.pIsCmp -> Just (C.tIsSeq -> Just (n, C.tIsBit -> True))) -> do n' <- importType sc n @@ -834,7 +837,7 @@ provePropRec sc prop0 prop = do (C.pIsLiteral -> Just (_, C.tIsFloat -> Just (e, p))) -> do e' <- importType sc e p' <- importType sc p - scGlobalApply sc "Cryptol.PLiteralFloat" [e', p'] + scGlobalApply sc "Cryptol.PLiteralFloatNum" [e', p'] -- instance (2 >= val) => LiteralLessThan val Bit (C.pIsLiteralLessThan -> Just (_, C.tIsBit -> True)) @@ -857,7 +860,7 @@ provePropRec sc prop0 prop = do (C.pIsLiteralLessThan -> Just (_, C.tIsFloat -> Just (e, p))) -> do e' <- importType sc e p' <- importType sc p - scGlobalApply sc "Cryptol.PLiteralFloat" [e', p'] + scGlobalApply sc "Cryptol.PLiteralFloatNum" [e', p'] -- Note that in the FLiteral instances below, we intentionally do not -- translate the first three arguments. @@ -870,7 +873,7 @@ provePropRec sc prop0 prop = do (C.pIsFLiteral -> Just (_, _, _, C.tIsFloat -> Just (e, p))) -> do e' <- importType sc e p' <- importType sc p - scGlobalApply sc "Cryptol.PFLiteralFloat" [e', p'] + scGlobalApply sc "Cryptol.PFLiteralFloatNum" [e', p'] _ -> do let prop0' = " " <> CryPP.pp prop0 @@ -1245,22 +1248,22 @@ floatPrims = , ("fpPosInf", flip scGlobalDef "Cryptol.ecFpPosInf") , ("fpFromBits", flip scGlobalDef "Cryptol.ecFpFromBits") , ("fpToBits", flip scGlobalDef "Cryptol.ecFpToBits") - , ("=.=", flip scGlobalDef "Cryptol.ecFpEq") + , ("=.=", flip scGlobalDef "Cryptol.ecFpLogicalEq") , ("fpAdd", flip scGlobalDef "Cryptol.ecFpAdd") , ("fpSub", flip scGlobalDef "Cryptol.ecFpSub") , ("fpMul", flip scGlobalDef "Cryptol.ecFpMul") , ("fpDiv", flip scGlobalDef "Cryptol.ecFpDiv") , ("fpToRational", flip scGlobalDef "Cryptol.ecFpToRational") , ("fpFromRational", flip scGlobalDef "Cryptol.ecFpFromRational") - , ("fpIsNaN", flip scGlobalDef "Cryptol.fpIsNaN") - , ("fpIsInf", flip scGlobalDef "Cryptol.fpIsInf") - , ("fpIsZero", flip scGlobalDef "Cryptol.fpIsZero") - , ("fpIsNeg", flip scGlobalDef "Cryptol.fpIsNeg") - , ("fpIsNormal", flip scGlobalDef "Cryptol.fpIsNormal") - , ("fpIsSubnormal", flip scGlobalDef "Cryptol.fpIsSubnormal") - , ("fpFMA", flip scGlobalDef "Cryptol.fpFMA") - , ("fpAbs", flip scGlobalDef "Cryptol.fpAbs") - , ("fpSqrt", flip scGlobalDef "Cryptol.fpSqrt") + , ("fpIsNaN", flip scGlobalDef "Cryptol.ecFpIsNaN") + , ("fpIsInf", flip scGlobalDef "Cryptol.ecFpIsInf") + , ("fpIsZero", flip scGlobalDef "Cryptol.ecFpIsZero") + , ("fpIsNeg", flip scGlobalDef "Cryptol.ecFpIsNeg") + , ("fpIsNormal", flip scGlobalDef "Cryptol.ecFpIsNormal") + , ("fpIsSubnormal", flip scGlobalDef "Cryptol.ecFpIsSubnormal") + , ("fpFMA", flip scGlobalDef "Cryptol.ecFpFMA") + , ("fpAbs", flip scGlobalDef "Cryptol.ecFpAbs") + , ("fpSqrt", flip scGlobalDef "Cryptol.ecFpSqrt") ] suiteBPrims :: Map C.PrimIdent (SharedContext -> IO Term) @@ -2005,25 +2008,19 @@ proveEq sc t1 t2 | otherwise = case (C.tNoUser t1, C.tNoUser t2) of (C.tIsSeq -> Just (n1, a1), C.tIsSeq -> Just (n2, a2)) -> - do n1' <- importType sc n1 - n2' <- importType sc n2 + do (n1', n2', nEq) <- proveNumEq sc n1 n2 a1' <- importType sc a1 a2' <- importType sc a2 - num <- scGlobalApply sc "Cryptol.Num" [] - nEq <- if n1 == n2 - then scGlobalApply sc "Prelude.Refl" [num, n1'] - else scGlobalApply sc "Prelude.unsafeAssert" [num, n1', n2'] aEq <- proveEq sc a1 a2 if a1 == a2 then scGlobalApply sc "Cryptol.seq_cong1" [n1', n2', a1', nEq] else scGlobalApply sc "Cryptol.seq_cong" [n1', n2', a1', a2', nEq, aEq] + (C.tIsFloat -> Just (e1, p1), C.tIsFloat -> Just (e2, p2)) -> + do (e1', e2', eEq) <- proveNumEq sc e1 e2 + (p1', p2', pEq) <- proveNumEq sc p1 p2 + scGlobalApply sc "Cryptol.FloatNum_cong" [e1', e2', p1', p2', eEq, pEq] (C.tIsIntMod -> Just n1, C.tIsIntMod -> Just n2) -> - do n1' <- importType sc n1 - n2' <- importType sc n2 - num <- scGlobalApply sc "Cryptol.Num" [] - nEq <- if n1 == n2 - then scGlobalApply sc "Prelude.Refl" [num, n1'] - else scGlobalApply sc "Prelude.unsafeAssert" [num, n1', n2'] + do (n1', n2', nEq) <- proveNumEq sc n1 n2 scGlobalApply sc "Cryptol.IntModNum_cong" [n1', n2', nEq] (C.tIsFun -> Just (a1, b1), C.tIsFun -> Just (a2, b2)) -> do a1' <- importType sc a1 @@ -2083,6 +2080,20 @@ proveEq sc t1 t2 ] +-- | Convert two @Num@ types to SAWCore 'Term's and create an equality term +-- between them. If the two @Num@s are syntactically equal, this simply uses +-- @Refl@ to equate them. Otherwise, this uses @unsafeAssert@, assuming that +-- Cryptol's typechecker has proven that the two @Num@s are in fact equal. +proveNumEq :: SharedContext -> C.Type -> C.Type -> IO (Term, Term, Term) +proveNumEq sc n1 n2 = + do n1' <- importType sc n1 + n2' <- importType sc n2 + num <- scGlobalApply sc "Cryptol.Num" [] + nEq <- if n1 == n2 + then scGlobalApply sc "Prelude.Refl" [num, n1'] + else scGlobalApply sc "Prelude.unsafeAssert" [num, n1', n2'] + pure (n1', n2', nEq) + -- | Create an equality term between two @RecordType@ values with the same -- field name. This works for equalities between record values and newtype -- values. @@ -2390,6 +2401,7 @@ scCryptolType sc t = SC.VIntType -> return (Right C.tInteger) SC.VIntModType n -> return (Right (C.tIntMod (C.tNum n))) SC.VRationalType -> return (Right C.tRational) + SC.VFloatType e p -> pure (Right (C.tFloat (C.tNum e) (C.tNum p))) SC.VArrayType v1 v2 -> do Right t1 <- asCryptolTypeValue v1 Right t2 <- asCryptolTypeValue v2 @@ -2467,7 +2479,15 @@ exportValue ty v = case ty of SC.VRational numer denom -> pure $ V.VRational $ V.SRational numer denom _ -> error $ "exportValue (on rational type " ++ show ty ++ ")" - TV.TVFloat _ _ -> panic "exportValue" ["Not yet implemented: Float"] + TV.TVFloat e p -> + case v of + SC.VFloat fof -> + pure $ V.VFloat $ V.BF + { V.bfExpWidth = e + , V.bfPrecWidth = p + , V.bfValue = fofValue fof + } + _ -> error $ "exportValue (on float type " ++ show ty ++ ")" TV.TVSeq _ e -> case v of diff --git a/cryptol-saw-core/src/CryptolSAWCore/TypedTerm.hs b/cryptol-saw-core/src/CryptolSAWCore/TypedTerm.hs index 5bfbc25565..15ee17a9e1 100644 --- a/cryptol-saw-core/src/CryptolSAWCore/TypedTerm.hs +++ b/cryptol-saw-core/src/CryptolSAWCore/TypedTerm.hs @@ -230,6 +230,7 @@ cryptolTypeOfFirstOrderType fot = FOTInt -> C.tInteger FOTIntMod n -> C.tIntMod (C.tNum n) FOTRational -> C.tRational + FOTFloat e p -> C.tFloat (C.tNum e) (C.tNum p) FOTVec n t -> C.tSeq (C.tNum n) (cryptolTypeOfFirstOrderType t) -- NB, special case, don't produce 1-tuples FOTTuple [x] -> cryptolTypeOfFirstOrderType x diff --git a/intTests/test1237_properties/FloatPropertiesGeneric.cry b/intTests/test1237_properties/FloatPropertiesGeneric.cry new file mode 100644 index 0000000000..58269da675 --- /dev/null +++ b/intTests/test1237_properties/FloatPropertiesGeneric.cry @@ -0,0 +1,860 @@ +// Various properties about floating-point operations. Naming conventions: +// +// - prop_*: This property should hold for all inputs, and an SMT solver can +// prove it within a reasonable amount of time. +// - check_*: This property should hold for all inputs, but an SMT solver +// cannot prove it within a reasonable amount of time. +// - counterexample_*: This property does not hold for all inputs. +module FloatPropertiesGeneric where + +import Float + +///// Helpers + +// `True` if the sign bit is set, `False` otherwise. If a number's sign bit is +// set, then that usually implies that the number is negative, and inversely, +// if a number's sign bit is unset, then that usually implies that the number +// is positive. The one exception to this rule is NaN, whose sign bit is unset +// but is considered to be neither a negative nor a positive number. The +// IEEE-754 standard does not interpret the sign of a NaN, so the sign bit has +// no mathematical meaning. +fpSign : {e, p} (ValidFloat e p, p >= 1) => Float e p -> Bit +fpSign x = head (fpToBits x) + +fpExponent : {e, p} (ValidFloat e p, p >= 1) => Float e p -> [e] +fpExponent x = take`{e} (drop`{1} (fpToBits x)) + +fpSignificand : {e, p} (ValidFloat e p, p >= 1) => Float e p -> [p - 1] +fpSignificand x = drop`{1 + e} (fpToBits x) + +fpIsPos : {e, p} ValidFloat e p => Float e p -> Bit +fpIsPos x = ~ (fpIsNeg x \/ fpIsNaN x) + +///// fpNaN + +prop_fpNaNIsNaN : {e, p} ValidFloat e p => Bit +prop_fpNaNIsNaN = fpIsNaN (fpNaN`{e, p}) + +prop_fpNaNIsNotInf : {e, p} ValidFloat e p => Bit +prop_fpNaNIsNotInf = ~ (fpIsInf (fpNaN`{e, p})) + +prop_fpNaNIsNotZero : {e, p} ValidFloat e p => Bit +prop_fpNaNIsNotZero = ~ (fpIsZero (fpNaN`{e, p})) + +prop_fpNaNIsNotNormal : {e, p} ValidFloat e p => Bit +prop_fpNaNIsNotNormal = ~ (fpIsNormal (fpNaN`{e, p})) + +prop_fpNaNIsNotSubnormal : {e, p} ValidFloat e p => Bit +prop_fpNaNIsNotSubnormal = ~ (fpIsSubnormal (fpNaN`{e, p})) + +// IEEE-754 specifies that a NaN value's exponent has all bits set to 1. +prop_fpNaNExponentAllOneBits : {e, p} (ValidFloat e p, p >= 1) => Bit +prop_fpNaNExponentAllOneBits = and (fpExponent (fpNaN`{e, p})) + +// IEEE-754 specifies that a NaN value's significand has at least one bit set. +// (If the significand is all zeroes, then the value would be infinite instead +// of a NaN.) +prop_fpNaNSignificandAtLeastOneBit : {e, p} (ValidFloat e p, p >= 1) => Bit +prop_fpNaNSignificandAtLeastOneBit = or (fpSignificand (fpNaN`{e, p})) + +///// fpPosInf + +prop_fpPosInfIsPos : {e, p} ValidFloat e p => Bit +prop_fpPosInfIsPos = fpIsPos (fpPosInf`{e, p}) + +prop_fpPosInfIsInf : {e, p} ValidFloat e p => Bit +prop_fpPosInfIsInf = fpIsInf (fpPosInf`{e, p}) + +prop_fpPosInfIsNotZero : {e, p} ValidFloat e p => Bit +prop_fpPosInfIsNotZero = ~ (fpIsZero (fpPosInf`{e, p})) + +prop_fpPosInfIsNotNaN : {e, p} ValidFloat e p => Bit +prop_fpPosInfIsNotNaN = ~ (fpIsNaN (fpPosInf`{e, p})) + +prop_fpPosInfIsNotNormal : {e, p} ValidFloat e p => Bit +prop_fpPosInfIsNotNormal = ~ (fpIsNormal (fpPosInf`{e, p})) + +prop_fpPosInfIsNotSubnormal : {e, p} ValidFloat e p => Bit +prop_fpPosInfIsNotSubnormal = ~ (fpIsSubnormal (fpPosInf`{e, p})) + +///// fpNegInf + +prop_fpNegInfIsNeg : {e, p} ValidFloat e p => Bit +prop_fpNegInfIsNeg = fpIsNeg (fpNegInf`{e, p}) + +prop_fpNegInfIsInf : {e, p} ValidFloat e p => Bit +prop_fpNegInfIsInf = fpIsInf (fpNegInf`{e, p}) + +prop_fpNegInfIsNotZero : {e, p} ValidFloat e p => Bit +prop_fpNegInfIsNotZero = ~ (fpIsZero (fpNegInf`{e, p})) + +prop_fpNegInfIsNotNaN : {e, p} ValidFloat e p => Bit +prop_fpNegInfIsNotNaN = ~ (fpIsNaN (fpNegInf`{e, p})) + +prop_fpNegInfIsNotNormal : {e, p} ValidFloat e p => Bit +prop_fpNegInfIsNotNormal = ~ (fpIsNormal (fpNegInf`{e, p})) + +prop_fpNegInfIsNotSubnormal : {e, p} ValidFloat e p => Bit +prop_fpNegInfIsNotSubnormal = ~ (fpIsSubnormal (fpNegInf`{e, p})) + +///// fpPosZero + +prop_fpPosZeroIsPos : {e, p} ValidFloat e p => Bit +prop_fpPosZeroIsPos = fpIsPos (fpPosZero`{e, p}) + +prop_fpPosZeroIsZero : {e, p} ValidFloat e p => Bit +prop_fpPosZeroIsZero = fpIsZero (fpPosZero`{e, p}) + +prop_fpPosZeroIsNotNaN : {e, p} ValidFloat e p => Bit +prop_fpPosZeroIsNotNaN = ~ (fpIsNaN (fpPosZero`{e, p})) + +prop_fpPosZeroIsNotInf : {e, p} ValidFloat e p => Bit +prop_fpPosZeroIsNotInf = ~ (fpIsInf (fpPosZero`{e, p})) + +prop_fpPosZeroIsNotNormal : {e, p} ValidFloat e p => Bit +prop_fpPosZeroIsNotNormal = ~ (fpIsNormal (fpPosZero`{e, p})) + +prop_fpPosZeroIsNotSubnormal : {e, p} ValidFloat e p => Bit +prop_fpPosZeroIsNotSubnormal = ~ (fpIsSubnormal (fpPosZero`{e, p})) + +///// fpNegZero + +prop_fpNegZeroIsNeg : {e, p} ValidFloat e p => Bit +prop_fpNegZeroIsNeg = fpIsNeg (fpNegZero`{e, p}) + +prop_fpNegZeroIsZero : {e, p} ValidFloat e p => Bit +prop_fpNegZeroIsZero = fpIsZero (fpNegZero`{e, p}) + +prop_fpNegZeroIsNotNaN : {e, p} ValidFloat e p => Bit +prop_fpNegZeroIsNotNaN = ~ (fpIsNaN (fpNegZero`{e, p})) + +prop_fpNegZeroIsNotInf : {e, p} ValidFloat e p => Bit +prop_fpNegZeroIsNotInf = ~ (fpIsInf (fpNegZero`{e, p})) + +prop_fpNegZeroIsNotNormal : {e, p} ValidFloat e p => Bit +prop_fpNegZeroIsNotNormal = ~ (fpIsNormal (fpNegZero`{e, p})) + +prop_fpNegZeroIsNotSubnormal : {e, p} ValidFloat e p => Bit +prop_fpNegZeroIsNotSubnormal = ~ (fpIsSubnormal (fpNegZero`{e, p})) + +///// fpFromBits and fpToBits + +prop_fpFromToBits : {e, p} ValidFloat e p => Float e p -> Bit +prop_fpFromToBits x = fpFromBits (fpToBits x) =.= x + +// Special case for NaN: there are multiple bit patterns for NaN values, but +// there is only one distinguished NaN value for the Float type. +prop_fpToFromBits : {e, p} ValidFloat e p => [e + p] -> Bit +prop_fpToFromBits bits = (fpToBits x == bits) \/ fpIsNaN x + where + x : Float e p + x = fpFromBits bits + +// Special case for NaN: there are multiple bit patterns for NaN values, but +// there is only one distinguished NaN value for the Float type. +prop_fpFromBitsCorrect : + {e, p} (ValidFloat e p, p >= 2) => Bit -> [e] -> [p - 1] -> Bit +prop_fpFromBitsCorrect sign exponent significand = + ((fpSign x == sign) /\ + (fpExponent x == exponent) /\ + (fpSignificand x == significand)) \/ fpIsNaN x + where + x : Float e p + x = fpFromBits ([sign] # exponent # significand) + +// Special case for NaN: there are multiple bit patterns for NaN values, but +// there is only one distinguished NaN value for the Float type. +prop_fpFromBitsEq : {e, p} ValidFloat e p => [e + p] -> [e + p] -> Bit +prop_fpFromBitsEq xbits ybits = + ~ (fpIsNaN x \/ fpIsNaN y) ==> ((xbits == ybits) == (x =.= y)) + where + x : Float e p + x = fpFromBits xbits + + y : Float e p + y = fpFromBits ybits + +prop_fpToBitsCorrect : {e, p} (ValidFloat e p, p >= 1) => Float e p -> Bit +prop_fpToBitsCorrect x = + fpToBits x == ([fpSign x] # fpExponent x # fpSignificand x) + +prop_fpToBitsEq : {e, p} ValidFloat e p => Float e p -> Float e p -> Bit +prop_fpToBitsEq x y = (x =.= y) == (fpToBits x == fpToBits y) + +///// (=.=) + +prop_fpLogicalEqNaN : {e, p} ValidFloat e p => Bit +prop_fpLogicalEqNaN = fpNaN`{e, p} =.= fpNaN + +prop_fpLogicalEqZero : {e, p} ValidFloat e p => Bit +prop_fpLogicalEqZero = ~ (fpNegZero`{e, p} =.= fpPosZero) + +prop_fpLogicalEqToIeeeEq : + {e, p} ValidFloat e p => Float e p -> Float e p -> Bit +prop_fpLogicalEqToIeeeEq x y = + (x =.= y /\ ~ (fpIsNaN x) /\ ~ (fpIsNaN y)) + ==> (x == y) + +prop_fpIeeeEqToLogicalEq : + {e, p} ValidFloat e p => Float e p -> Float e p -> Bit +prop_fpIeeeEqToLogicalEq x y = + ((x == y /\ (fpIsNeg x == fpIsNeg y)) \/ (fpIsNaN x /\ fpIsNaN y)) + ==> (x =.= y) + +prop_fpLogicalEqReflexive : {e, p} ValidFloat e p => Float e p -> Bit +prop_fpLogicalEqReflexive x = x =.= x + +prop_fpLogicalEqSymmetric : + {e, p} ValidFloat e p => Float e p -> Float e p -> Bit +prop_fpLogicalEqSymmetric x y = (x =.= y) ==> (y =.= x) + +prop_fpLogicalEqTransitive : + {e, p} ValidFloat e p => Float e p -> Float e p -> Float e p -> Bit +prop_fpLogicalEqTransitive x y z = (x =.= y /\ y =.= z) ==> (x =.= z) + +///// fpIsNeg + +prop_fpIsPosSign : {e, p} (ValidFloat e p, p >= 1) => Float e p -> Bit +prop_fpIsPosSign x = fpIsPos x ==> ~ (fpSign x) + +prop_fpIsNegSign : {e, p} (ValidFloat e p, p >= 1) => Float e p -> Bit +prop_fpIsNegSign x = fpIsNeg x ==> fpSign x + +///// fpIsNormal + +prop_fpIsNormalCorrect : {e, p} ValidFloat e p => Float e p -> Bit +prop_fpIsNormalCorrect x = + fpIsNormal x == + (~ (fpIsNaN x) /\ ~ (fpIsInf x) /\ ~ (fpIsZero x) /\ ~ (fpIsSubnormal x)) + +///// fpAdd + +prop_fpAddNaN : + {e, p} ValidFloat e p => RoundingMode -> Float e p -> Float e p -> Bit +prop_fpAddNaN m x y = (fpIsNaN x \/ fpIsNaN y) ==> fpIsNaN (fpAdd m x y) + +prop_fpAddPosNegInf : {e, p} ValidFloat e p => RoundingMode -> Bit +prop_fpAddPosNegInf m = fpAdd m fpPosInf`{e, p} fpNegInf =.= fpNaN + +prop_fpAddNegPosInf : {e, p} ValidFloat e p => RoundingMode -> Bit +prop_fpAddNegPosInf m = fpAdd m fpNegInf`{e, p} fpPosInf =.= fpNaN + +// Special cases: +// +// * NaN: inf + NaN =.= NaN (not inf) +// * Infinity values: inf + (-inf) =.= NaN (not inf) +prop_fpAddLeftInf : + {e, p} ValidFloat e p => RoundingMode -> Float e p -> Float e p -> Bit +prop_fpAddLeftInf m x y = + fpIsInf x /\ ~ (fpIsNaN y \/ (x =.= -y)) ==> + (fpAdd m x y =.= if fpIsNeg x then fpNegInf else fpPosInf) + +// Special cases: +// +// * NaN: NaN + inf =.= NaN (not inf) +// * Infinity values: (-inf) + inf =.= NaN (not inf) +prop_fpAddRightInf : + {e, p} ValidFloat e p => RoundingMode -> Float e p -> Float e p -> Bit +prop_fpAddRightInf m x y = + fpIsInf y /\ ~ (fpIsNaN x \/ (x =.= -y)) ==> + (fpAdd m x y =.= if fpIsNeg y then fpNegInf else fpPosInf) + +prop_fpAddLeftIdentity : + {e, p} ValidFloat e p => RoundingMode -> Float e p -> Float e p -> Bit +prop_fpAddLeftIdentity m x z = + ~ (fpIsNaN x) /\ fpIsZero z ==> + fpAdd m x z == x + +prop_fpAddRightIdentity : + {e, p} ValidFloat e p => RoundingMode -> Float e p -> Float e p -> Bit +prop_fpAddRightIdentity m x z = + ~ (fpIsNaN x) /\ fpIsZero z ==> + fpAdd m z x == x + +prop_fpAddCommutative : + {e, p} ValidFloat e p => RoundingMode -> Float e p -> Float e p -> Bit +prop_fpAddCommutative m x y = fpAdd m x y =.= fpAdd m y x + +// Special cases: +// +// * Infinite values, e.g., `inf + (-inf) =.= NaN` (not 0) +// * NaN values, since `NaN + (-NaN) =.= NaN` (not 0) +prop_fpAddInverse : + {e, p} ValidFloat e p => RoundingMode -> Float e p -> Bit +prop_fpAddInverse m x = + (~ (fpIsInf x) /\ ~ (fpIsNaN x)) ==> fpIsZero (fpAdd m x (- x)) + +counterexample_fpAddAssociative : + {e, p} ValidFloat e p => RoundingMode -> + Float e p -> Float e p -> Float e p -> Bit +counterexample_fpAddAssociative m x y z = + ~ (fpAdd m x (fpAdd m y z) =.= fpAdd m (fpAdd m x y) z) + +///// fpSub + +prop_fpSubNaN : + {e, p} ValidFloat e p => RoundingMode -> Float e p -> Float e p -> Bit +prop_fpSubNaN m x y = (fpIsNaN x \/ fpIsNaN y) ==> fpIsNaN (fpSub m x y) + +prop_fpSubPosPosInf : {e, p} ValidFloat e p => RoundingMode -> Bit +prop_fpSubPosPosInf m = fpSub m fpPosInf`{e, p} fpPosInf =.= fpNaN + +prop_fpSubNegNegInf : {e, p} ValidFloat e p => RoundingMode -> Bit +prop_fpSubNegNegInf m = fpSub m fpNegInf`{e, p} fpNegInf =.= fpNaN + +// Special cases: +// +// * NaN: inf - NaN =.= NaN (not inf) +// * Infinity values: inf - inf =.= NaN (not inf) +prop_fpSubLeftInf : + {e, p} ValidFloat e p => RoundingMode -> Float e p -> Float e p -> Bit +prop_fpSubLeftInf m x y = + fpIsInf x /\ ~ (fpIsNaN y \/ (x =.= y)) ==> + (fpSub m x y =.= if fpIsNeg x then fpNegInf else fpPosInf) + +// Special cases: +// +// * NaN: NaN - inf =.= NaN (not inf) +// * Infinity values: inf - inf =.= NaN (not inf) +prop_fpSubRightInf : + {e, p} ValidFloat e p => RoundingMode -> Float e p -> Float e p -> Bit +prop_fpSubRightInf m x y = + fpIsInf y /\ ~ (fpIsNaN x \/ (x =.= y)) ==> + (fpSub m x y =.= if fpIsNeg y then fpPosInf else fpNegInf) + +prop_fpSubZeroLeft : + {e, p} ValidFloat e p => RoundingMode -> Float e p -> Float e p -> Bit +prop_fpSubZeroLeft m x z = + ~ (fpIsNaN x) /\ fpIsZero z ==> + fpSub m z x == -x + +prop_fpSubZeroRight : + {e, p} ValidFloat e p => RoundingMode -> Float e p -> Float e p -> Bit +prop_fpSubZeroRight m x z = + ~ (fpIsNaN x) /\ fpIsZero z ==> + fpSub m x z == x + +prop_fpSubPosPos : + {e, p} ValidFloat e p => RoundingMode -> Float e p -> Float e p -> Bit +prop_fpSubPosPos m x y = + (fpIsPos x /\ fpIsPos y) ==> + (((x > y) ==> fpIsPos s) /\ ((y > x) ==> fpIsNeg s)) + where + s = fpSub m x y + +prop_fpSubNegAdd : + {e, p} ValidFloat e p => RoundingMode -> Float e p -> Float e p -> Bit +prop_fpSubNegAdd m x y = fpSub m x (-y) =.= fpAdd m x y + +prop_fpAddNegSub : + {e, p} ValidFloat e p => RoundingMode -> Float e p -> Float e p -> Bit +prop_fpAddNegSub m x y = fpAdd m x (-y) =.= fpSub m x y + +// Special case for equal arguments, since `(x - x) =.= +0`, but +// `-(x - x) =.= -0`. +prop_fpSubAnticommutative : + {e, p} ValidFloat e p => RoundingMode -> Float e p -> Float e p -> Bit +prop_fpSubAnticommutative m x y = + ~ (x == x) ==> (fpSub m x y =.= -(fpSub m y x)) + +// Special cases: +// +// * Infinite values, e.g., `inf - inf =.= NaN` (not 0) +// * NaN values, since `NaN - NaN =.= NaN` (not 0) +prop_fpSubSelfInverse : + {e, p} ValidFloat e p => RoundingMode -> Float e p -> Bit +prop_fpSubSelfInverse m x = + (~ (fpIsInf x) /\ ~ (fpIsNaN x)) ==> fpIsZero (fpSub m x x) + +///// fpMul + +prop_fpMulNaN : + {e, p} ValidFloat e p => RoundingMode -> Float e p -> Float e p -> Bit +prop_fpMulNaN m x y = + (fpIsNaN x \/ fpIsNaN y) ==> fpIsNaN (fpMul m x y) + +prop_fpMulZeroInf : + {e, p} ValidFloat e p => RoundingMode -> Float e p -> Float e p -> Bit +prop_fpMulZeroInf m x y = + (fpIsZero x /\ fpIsInf y) ==> fpIsNaN (fpMul m x y) + + +prop_fpMulInfZero : + {e, p} ValidFloat e p => RoundingMode -> Float e p -> Float e p -> Bit +prop_fpMulInfZero m x y = + (fpIsInf x /\ fpIsZero y) ==> fpIsNaN (fpMul m x y) + +prop_fpMulLeftInf : + {e, p} ValidFloat e p => RoundingMode -> Float e p -> Float e p -> Bit +prop_fpMulLeftInf m x y = + (fpIsInf x /\ ~ (fpIsZero y \/ fpIsNaN y)) ==> fpIsInf (fpMul m x y) + +prop_fpMulRightInf : + {e, p} ValidFloat e p => RoundingMode -> Float e p -> Float e p -> Bit +prop_fpMulRightInf m x y = + (~ (fpIsZero x \/ fpIsNaN x) /\ fpIsInf y) ==> fpIsInf (fpMul m x y) + +prop_fpMulLeftIdentity : + {e, p} ValidFloat e p => RoundingMode -> Float e p -> Bit +prop_fpMulLeftIdentity m y = fpMul m 1.0 y =.= y + +prop_fpMulRightIdentity : + {e, p} ValidFloat e p => RoundingMode -> Float e p -> Bit +prop_fpMulRightIdentity m x = fpMul m x 1.0 =.= x + +// Special cases: +// +// * NaN: NaN * 0 =.= NaN (not 0) +// * Infinite values: inf * 0 =.= NaN (not 0) +prop_fpMulLeftPosZero : + {e, p} ValidFloat e p => RoundingMode -> Float e p -> Bit +prop_fpMulLeftPosZero m y = + ~ (fpIsNaN y \/ fpIsInf y) ==> + (fpMul m fpPosZero y =.= if fpIsNeg y then fpNegZero else fpPosZero) + +// Special cases: +// +// * NaN: 0 * NaN =.= NaN (not 0) +// * Infinite values: 0 * inf =.= NaN (not 0) +prop_fpMulRightPosZero : + {e, p} ValidFloat e p => RoundingMode -> Float e p -> Bit +prop_fpMulRightPosZero m x = + ~ (fpIsNaN x \/ fpIsInf x) ==> + (fpMul m x fpPosZero =.= if fpIsNeg x then fpNegZero else fpPosZero) + +// Special cases: +// +// * NaN: NaN * 0 =.= NaN (not 0) +// * Infinite values: inf * 0 =.= NaN (not 0) +prop_fpMulLeftNegZero : + {e, p} ValidFloat e p => RoundingMode -> Float e p -> Bit +prop_fpMulLeftNegZero m y = + ~ (fpIsNaN y \/ fpIsInf y) ==> + (fpMul m fpNegZero y =.= if fpIsNeg y then fpPosZero else fpNegZero) + +// Special cases: +// +// * NaN: 0 * NaN =.= NaN (not 0) +// * Infinite values: 0 * inf =.= NaN (not 0) +prop_fpMulRightNegZero : + {e, p} ValidFloat e p => RoundingMode -> Float e p -> Bit +prop_fpMulRightNegZero m x = + ~ (fpIsNaN x \/ fpIsInf x) ==> + (fpMul m x fpNegZero =.= if fpIsNeg x then fpPosZero else fpNegZero) + +// Special cases: +// +// * Infinite/zero: `-inf * -0 =.= -0 * -inf =.= NaN`, and NaN is not +// considered to be positive. +prop_fpMulNegNeg : + {e, p} ValidFloat e p => RoundingMode -> Float e p -> Float e p -> Bit +prop_fpMulNegNeg m x y = + ~ ((fpIsInf x /\ fpIsZero y) \/ (fpIsZero x /\ fpIsInf y)) ==> + (fpIsNeg x /\ fpIsNeg y) ==> fpIsPos (fpMul m x y) + +// Special cases: +// +// * Infinite/zero: `inf * 0 =.= 0 * inf =.= NaN`, and NaN is not considered to +// be positive. +prop_fpMulPosPos : + {e, p} ValidFloat e p => RoundingMode -> Float e p -> Float e p -> Bit +prop_fpMulPosPos m x y = + ~ ((fpIsInf x /\ fpIsZero y) \/ (fpIsZero x /\ fpIsInf y)) ==> + (fpIsPos x /\ fpIsPos y) ==> fpIsPos (fpMul m x y) + +// Special cases: +// +// * Infinite/zero: `-inf * 0 =.= -0 * inf =.= NaN`, and NaN is not considered +// to be positive. +prop_fpMulNegPos : + {e, p} ValidFloat e p => RoundingMode -> Float e p -> Float e p -> Bit +prop_fpMulNegPos m x y = + ~ ((fpIsInf x /\ fpIsZero y) \/ (fpIsZero x /\ fpIsInf y)) ==> + (fpIsNeg x /\ fpIsPos y) ==> fpIsNeg (fpMul m x y) + +// Special cases: +// +// * Infinite/zero: `inf * -0 =.= 0 * -inf =.= NaN`, and NaN is not considered +// to be positive. +prop_fpMulPosNeg : + {e, p} ValidFloat e p => RoundingMode -> Float e p -> Float e p -> Bit +prop_fpMulPosNeg m x y = + ~ ((fpIsInf x /\ fpIsZero y) \/ (fpIsZero x /\ fpIsInf y)) ==> + (fpIsPos x /\ fpIsNeg y) ==> fpIsNeg (fpMul m x y) + +prop_fpMulCommutative : + {e, p} ValidFloat e p => RoundingMode -> Float e p -> Float e p -> Bit +prop_fpMulCommutative m x y = fpMul m x y =.= fpMul m y x + +counterexample_fpMulAssociative : + {e, p} ValidFloat e p => RoundingMode -> + Float e p -> Float e p -> Float e p -> Bit +counterexample_fpMulAssociative m x y z = + ~ (fpMul m x (fpMul m y z) =.= fpMul m (fpMul m x y) z) + +counterexample_fpMulDistributive : + {e, p} ValidFloat e p => RoundingMode -> + Float e p -> Float e p -> Float e p -> Bit +counterexample_fpMulDistributive m x y z = + ~ (fpMul m x (fpAdd m y z) =.= fpAdd m (fpMul m x y) (fpMul m x z)) + +///// fpDiv + +prop_fpDivNaN : + {e, p} ValidFloat e p => RoundingMode -> Float e p -> Float e p -> Bit +prop_fpDivNaN m x y = + (fpIsNaN x \/ fpIsNaN y) ==> fpIsNaN (fpDiv m x y) + +prop_fpDivInfInf : + {e, p} ValidFloat e p => RoundingMode -> Float e p -> Float e p -> Bit +prop_fpDivInfInf m x y = + (fpIsInf x /\ fpIsInf y) ==> fpIsNaN (fpDiv m x y) + +// Special cases: +// +// * Infinite values: inf / inf =.= NaN (not inf) +// * NaN: inf / NaN =.= NaN (not inf) +prop_fpDivPosInfDividend : + {e, p} ValidFloat e p => RoundingMode -> Float e p -> Bit +prop_fpDivPosInfDividend m x = + ~ (fpIsInf x \/ fpIsNaN x) ==> + fpDiv m fpPosInf x =.= if fpIsNeg x then fpNegInf else fpPosInf + +// Special cases: +// +// * Infinite values: -inf / inf =.= NaN (not -inf) +// * NaN: -inf / NaN =.= NaN (not -inf) +prop_fpDivNegInfDividend : + {e, p} ValidFloat e p => RoundingMode -> Float e p -> Bit +prop_fpDivNegInfDividend m x = + ~ (fpIsInf x \/ fpIsNaN x) ==> + fpDiv m fpNegInf x =.= if fpIsNeg x then fpPosInf else fpNegInf + +// Special cases: +// +// * Infinite values: inf / inf =.= NaN (not 0) +// * NaN: NaN / inf =.= NaN (not 0) +prop_fpDivPosInfDivisor : + {e, p} ValidFloat e p => RoundingMode -> Float e p -> Bit +prop_fpDivPosInfDivisor m x = + ~ (fpIsInf x \/ fpIsNaN x) ==> + fpDiv m x fpPosInf =.= if fpIsNeg x then fpNegZero else fpPosZero + +// Special cases: +// +// * Infinite values: inf / -inf =.= NaN (not -0) +// * NaN: NaN / -inf =.= NaN (not -0) +prop_fpDivNegInfDivisor : + {e, p} ValidFloat e p => RoundingMode -> Float e p -> Bit +prop_fpDivNegInfDivisor m x = + ~ (fpIsInf x \/ fpIsNaN x) ==> + fpDiv m x fpNegInf =.= if fpIsNeg x then fpPosZero else fpNegZero + +// Special cases: +// +// * Zero: 0 / 0 =.= NaN (not 0) +// * NaN: 0 / NaN =.= NaN (not 0) +prop_fpDivPosZeroDividend : + {e, p} ValidFloat e p => RoundingMode -> Float e p -> Bit +prop_fpDivPosZeroDividend m x = + ~ (fpIsZero x \/ fpIsNaN x) ==> + fpDiv m fpPosZero x =.= if fpIsNeg x then fpNegZero else fpPosZero + +// Special cases: +// +// * Zero: -0 / 0 =.= NaN (not -0) +// * NaN: -0 / NaN =.= NaN (not -0) +prop_fpDivNegZeroDividend : + {e, p} ValidFloat e p => RoundingMode -> Float e p -> Bit +prop_fpDivNegZeroDividend m x = + ~ (fpIsZero x \/ fpIsNaN x) ==> + fpDiv m fpNegZero x =.= if fpIsNeg x then fpPosZero else fpNegZero + +// Special cases: +// +// * Zero: 0 / 0 =.= NaN (not inf) +// * NaN: NaN / 0 =.= NaN (not inf) +prop_fpDivPosZeroDivisor : + {e, p} ValidFloat e p => RoundingMode -> Float e p -> Bit +prop_fpDivPosZeroDivisor m x = + ~ (fpIsZero x \/ fpIsNaN x) ==> + fpDiv m x fpPosZero =.= if fpIsNeg x then fpNegInf else fpPosInf + +// Special cases: +// +// * Zero: 0 / -0 =.= NaN (not -inf) +// * NaN: NaN / -0 =.= NaN (not -inf) +prop_fpDivNegZeroDivisor : + {e, p} ValidFloat e p => RoundingMode -> Float e p -> Bit +prop_fpDivNegZeroDivisor m x = + ~ (fpIsZero x \/ fpIsNaN x) ==> + fpDiv m x fpNegZero =.= if fpIsNeg x then fpPosInf else fpNegInf + +prop_fpDivOne : + {e, p} ValidFloat e p => RoundingMode -> Float e p -> Bit +prop_fpDivOne m x = fpDiv m x 1.0 =.= x + +// Special cases for zero, infinite, and NaN values, where `x / x =.= NaN` +// (not 1). +prop_fpDivInverse : + {e, p} ValidFloat e p => RoundingMode -> Float e p -> Bit +prop_fpDivInverse m x = + ~ (fpIsZero x \/ fpIsInf x \/ fpIsNaN x) ==> (fpDiv m x x =.= 1.0) + +counterexample_fpDivDistributive : + {e, p} ValidFloat e p => RoundingMode -> + Float e p -> Float e p -> Float e p -> Bit +counterexample_fpDivDistributive m x y z = + ~ (fpDiv m (fpAdd m x y) z =.= fpAdd m (fpDiv m x z) (fpDiv m y z)) + +///// fpFMA + +prop_fpFMACommutative : + {e, p} ValidFloat e p => RoundingMode -> + Float e p -> Float e p -> Float e p -> Bit +prop_fpFMACommutative m x y z = fpFMA m x y z =.= fpFMA m y x z + +counterexample_fpFMAAssociative : + {e, p} ValidFloat e p => RoundingMode -> + Float e p -> Float e p -> Float e p -> Bit +counterexample_fpFMAAssociative m x y z = + ~ (fpFMA m x y z =.= fpAdd m (fpMul m x y) z) + +counterexample_fpFMAExpand : + {e, p} ValidFloat e p => RoundingMode -> + Float e p -> Float e p -> Float e p -> Bit +counterexample_fpFMAExpand m x y z = + ~ (fpFMA m x y z =.= fpAdd m (fpMul m x y) z) + +///// fpAbs + +prop_fpAbsZero : {e, p} ValidFloat e p => Float e p -> Bit +prop_fpAbsZero x = fpIsZero x ==> (fpAbs x =.= fpPosZero) + +prop_fpAbsPos : {e, p} ValidFloat e p => Float e p -> Bit +prop_fpAbsPos x = fpIsPos x ==> (fpAbs x =.= x) + +prop_fpAbsNeg : {e, p} ValidFloat e p => Float e p -> Bit +prop_fpAbsNeg x = fpIsNeg x ==> (fpAbs x =.= -x) + +prop_fpAbsNaN : {e, p} ValidFloat e p => Bit +prop_fpAbsNaN = fpAbs (fpNaN`{e, p}) =.= fpNaN + + +prop_fpAbsInf : {e, p} ValidFloat e p => Float e p -> Bit +prop_fpAbsInf x = fpIsInf x ==> (fpAbs x =.= fpPosInf) + +///// fpSqrt + +prop_fpSqrtNaN : {e, p} ValidFloat e p => RoundingMode -> Bit +prop_fpSqrtNaN m = fpIsNaN (fpSqrt m fpNaN`{e, p}) + +prop_fpSqrtPosInf : {e, p} ValidFloat e p => RoundingMode -> Bit +prop_fpSqrtPosInf m = fpSqrt m fpPosInf`{e, p} =.= fpPosInf + +prop_fpSqrtPosZero : {e, p} ValidFloat e p => RoundingMode -> Bit +prop_fpSqrtPosZero m = fpSqrt m fpPosZero`{e, p} =.= fpPosZero + +prop_fpSqrtNegZero : {e, p} ValidFloat e p => RoundingMode -> Bit +prop_fpSqrtNegZero m = fpSqrt m fpNegZero`{e,p} =.= fpNegZero + +// Normally, the square root of any negative value results in a NaN, but we +// must include a special case for `sqrt(-0) =.= -0`. +prop_fpSqrtNeg : {e, p} ValidFloat e p => RoundingMode -> Float e p -> Bit +prop_fpSqrtNeg m x = fpIsNeg x ==> (fpIsNaN (fpSqrt m x) \/ (x =.= fpNegZero)) + +counterexample_fpSqrtMul : + {e, p} ValidFloat e p => RoundingMode -> Float e p -> Float e p -> Bit +counterexample_fpSqrtMul m x y = + ~ ((fpIsNeg x == fpIsNeg y) + ==> fpSqrt m (fpMul m x y) =.= fpMul m (fpSqrt m x) (fpSqrt m y)) + +counterexample_fpSqrtDiv : + {e, p} ValidFloat e p => RoundingMode -> Float e p -> Float e p -> Bit +counterexample_fpSqrtDiv m x y = + ~ ((fpIsNeg x == fpIsNeg y) + ==> fpSqrt m (fpDiv m x y) =.= fpDiv m (fpSqrt m x) (fpSqrt m y)) + +counterexample_fpSqrtSquare : + {e, p} ValidFloat e p => RoundingMode -> Float e p -> Bit +counterexample_fpSqrtSquare m x = + ~ (fpIsPos x ==> fpSqrt m (fpMul m x x) =.= x) + +counterexample_fpSqrtSquared : + {e, p} ValidFloat e p => RoundingMode -> Float e p -> Bit +counterexample_fpSqrtSquared m x = + ~ (fpIsPos x ==> (fpMul m root root =.= x)) + where + root = fpSqrt m x + +///// fpToRational and fpFromRational + +check_fpFromToRational : + {e, p} ValidFloat e p => RoundingMode -> Float e p -> Bit +check_fpFromToRational m x = + ~ (fpIsInf x \/ fpIsNaN x) ==> + fpFromRational m (fpToRational x) == x + +///// Eq + +prop_fpEqNaN : {e, p} ValidFloat e p => Bit +prop_fpEqNaN = fpNaN`{e, p} != fpNaN + +prop_fpEqZero : {e, p} ValidFloat e p => Float e p -> Float e p -> Bit +prop_fpEqZero x y = (fpIsZero x /\ fpIsZero y) ==> (x == y) + +prop_fpEqReflexive : {e, p} ValidFloat e p => Float e p -> Bit +prop_fpEqReflexive x = ~ (fpIsNaN x) ==> (x == x) + +prop_fpEqSymmetric : {e, p} ValidFloat e p => Float e p -> Float e p -> Bit +prop_fpEqSymmetric x y = (x == y) ==> (y == x) + +prop_fpEqTransitive : + {e, p} ValidFloat e p => Float e p -> Float e p -> Float e p -> Bit +prop_fpEqTransitive x y z = (x == y /\ y == z) ==> (x == z) + +///// Cmp + +prop_fpCmpNaN : {e, p} ValidFloat e p => Bit +prop_fpCmpNaN = + ~ ((x < x) \/ (x <= x) \/ (x > x) \/ (x >= x)) + where + x : Float e p + x = fpNaN + +prop_fpCmpZero : {e, p} ValidFloat e p => Float e p -> Float e p -> Bit +prop_fpCmpZero x y = + (fpIsZero x /\ fpIsZero y) ==> + (((x <= y) /\ (x >= y)) /\ ~((x < x) \/ (x > x))) + +prop_fpCmpLtIrreflexive : {e, p} ValidFloat e p => Float e p -> Bit +prop_fpCmpLtIrreflexive x = ~ (x < x) + +prop_fpCmpLtAsymmetric : {e, p} ValidFloat e p => Float e p -> Float e p -> Bit +prop_fpCmpLtAsymmetric x y = (x < y) ==> ~ (y < x) + +prop_fpCmpLtTransitive : + {e, p} ValidFloat e p => Float e p -> Float e p -> Float e p -> Bit +prop_fpCmpLtTransitive x y z = (x < y /\ y < z) ==> (x < z) + +prop_fpCmpLeReflexive : {e, p} ValidFloat e p => Float e p -> Bit +prop_fpCmpLeReflexive x = ~ (fpIsNaN x) ==> (x <= x) + +prop_fpCmpLeAntisymmetric : + {e, p} ValidFloat e p => Float e p -> Float e p -> Bit +prop_fpCmpLeAntisymmetric x y = + (x <= y /\ y <= x) ==> (x == y) + +prop_fpCmpLeTransitive : + {e, p} ValidFloat e p => Float e p -> Float e p -> Float e p -> Bit +prop_fpCmpLeTransitive x y z = + (x <= y /\ y <= z) ==> (x <= z) + +prop_fpCmpLeTotal : {e, p} ValidFloat e p => Float e p -> Float e p -> Bit +prop_fpCmpLeTotal x y = ~ (fpIsNaN x \/ fpIsNaN y) ==> ((x <= y) \/ (y <= x)) + +prop_fpCmpGtCorrect : {e, p} ValidFloat e p => Float e p -> Float e p -> Bit +prop_fpCmpGtCorrect x y = ~ (fpIsNaN x \/ fpIsNaN y) ==> ((x > y) == ~ (x <= y)) + +prop_fpCmpGeCorrect : {e, p} ValidFloat e p => Float e p -> Float e p -> Bit +prop_fpCmpGeCorrect x y = ~ (fpIsNaN x \/ fpIsNaN y) ==> (x <= y) == ~ (x > y) + +///// Zero + +prop_fpZero : {e, p} ValidFloat e p => Bit +prop_fpZero = zero =.= fpPosZero`{e, p} + +///// Ring + +prop_fpRingAdd : {e, p} ValidFloat e p => Float e p -> Float e p -> Bit +prop_fpRingAdd x y = (x + y) =.= fpAdd rne x y + +prop_fpRingSub : {e, p} ValidFloat e p => Float e p -> Float e p -> Bit +prop_fpRingSub x y = (x - y) =.= fpSub rne x y + +prop_fpRingMul : {e, p} ValidFloat e p => Float e p -> Float e p -> Bit +prop_fpRingMul x y = (x * y) =.= fpMul rne x y + +prop_fpRingNegate : {e, p} ValidFloat e p => Float e p -> Bit +prop_fpRingNegate x = negate x =.= fpSub rne (-0.0) x + +///// Field + +prop_fpFieldDiv : {e, p} ValidFloat e p => Float e p -> Float e p -> Bit +prop_fpFieldDiv x y = (x /. y) =.= fpDiv rne x y + +prop_fpFieldRecip : {e, p} ValidFloat e p => Float e p -> Bit +prop_fpFieldRecip x = recip x =.= fpDiv rne 1.0 x + +///// Round + +check_fpRoundFloorCeiling : {e, p} ValidFloat e p => Float e p -> Bit +check_fpRoundFloorCeiling x = + ~ (fpIsInf x \/ fpIsNaN x) ==> + floor x == -(ceiling (-x)) + +check_fpRoundCeilingFloor : {e, p} ValidFloat e p => Float e p -> Bit +check_fpRoundCeilingFloor x = + ~ (fpIsInf x \/ fpIsNaN x) ==> + ceiling x == -(floor (-x)) + +check_fpRoundFloorCorrect : {e, p} ValidFloat e p => Float e p -> Bit +check_fpRoundFloorCorrect x = + ~ (fpIsInf x \/ fpIsNaN x) ==> + (f <= x' /\ x' < f + 1) + where + x' : Rational + x' = fpToRational x + + f : Rational + f = ratio (floor x) 1 + +check_fpRoundCeilingCorrect : {e, p} ValidFloat e p => Float e p -> Bit +check_fpRoundCeilingCorrect x = + ~ (fpIsInf x \/ fpIsNaN x) ==> + (x' <= c /\ c < x' + 1) + where + x' : Rational + x' = fpToRational x + + c : Rational + c = ratio (ceiling x) 1 + +check_fpRoundTruncCeilingFloor : {e, p} ValidFloat e p => Float e p -> Bit +check_fpRoundTruncCeilingFloor x = + ~ (fpIsInf x \/ fpIsNaN x) ==> + trunc x == if fpIsNeg x then ceiling x else floor x + +check_fpRoundTruncCorrect : {e, p} ValidFloat e p => Float e p -> Bit +check_fpRoundTruncCorrect x = + ~ (fpIsInf x \/ fpIsNaN x) ==> + if fpIsNeg x + then (x' <= t /\ t < x' + 1) + else (t <= x' /\ x' < t + 1) + where + x' : Rational + x' = fpToRational x + + t : Rational + t = ratio (trunc x) 1 + +check_fpRoundAwayTrunc : {e, p} ValidFloat e p => Float e p -> Bit +check_fpRoundAwayTrunc x = + ~ (fpIsInf x \/ fpIsNaN x) ==> + roundAway x == if fpIsNeg x then trunc (x' - 0.5) else trunc (x' + 0.5) + where + x' : Rational + x' = fpToRational x + +check_fpRoundAwayCorrect : {e, p} ValidFloat e p => Float e p -> Bit +check_fpRoundAwayCorrect x = + ~ (fpIsInf x \/ fpIsNaN x) ==> + if fpIsNeg x + then (2*x' - 1 <= 2*r) /\ (2*r < 2*x' + 1) + else (2*x' - 1 < 2*r) /\ (2*r <= 2*x' + 1) + where + x' : Rational + x' = fpToRational x + + r : Rational + r = ratio (roundAway x) 1 diff --git a/intTests/test1237_properties/GenFloatProperties.hs b/intTests/test1237_properties/GenFloatProperties.hs new file mode 100644 index 0000000000..91a81a0f1a --- /dev/null +++ b/intTests/test1237_properties/GenFloatProperties.hs @@ -0,0 +1,114 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_GHC -Wall #-} +-- | Generate a Cryptol script that proves, checks, or disproves various +-- Cryptol properties about floating-point operations. +-- +-- Note that all of these properties are parameterized over arbitrary exponents +-- and precisions, and many of the properties are also parameterized over +-- arbitrary rounding modes, so this will generate code which instantiates each +-- property at a particular float size and at all supported rounding modes. +module Main (main) where + +import Data.Text (Text) +import qualified Data.Text as T +import qualified Data.Text.IO as T +import System.FilePath (dropExtension) + +data ResultType + = ProveProperty + -- ^ Something which should hold for all inputs, and an SMT solver is able + -- to prove it. + | CheckProperty + -- ^ Something which should hold for all inputs, but most SMT solvers + -- cannot prove it (at least, not without taking an extraordinarily long + -- time). We resort to spot-checking these properties on specific inputs. + | Counterexample + -- ^ Something which does not hold for at least one input. + +data Result = Result + { resultName :: !Text + , resultType :: !ResultType + , resultHasRoundingMode :: !Bool + } + +propertiesFile :: FilePath +propertiesFile = "FloatPropertiesGeneric.cry" + +sawFile :: FilePath +sawFile = "test.saw" + +scriptFile :: FilePath +scriptFile = "GenFloatProperties.hs" + +scrapeResults :: IO [Result] +scrapeResults = do + ls0 <- T.lines <$> T.readFile propertiesFile + let ls1 = zip ls0 (drop 1 (cycle ls0)) + let ls2 = + filter + (\(l, _) -> + any (`T.isPrefixOf` l) ["prop_", "check_", "counterexample_"] && + (" :" `T.isInfixOf` l)) + ls1 + pure $ + map + (\(l1, l2) -> + let name = head (T.splitOn " " l1) in + Result + { resultName = + name + , resultType = + if "prop_" `T.isPrefixOf` l1 then ProveProperty + else if "check_" `T.isPrefixOf` l1 then CheckProperty + else if "counterexample_" `T.isPrefixOf` l1 then Counterexample + else error $ "Unsupported result name: " ++ T.unpack name + , resultHasRoundingMode = + any ("RoundingMode" `T.isInfixOf`) [l1, l2] + }) + ls2 + +resultCommandLines :: Result -> [Text] +resultCommandLines r = + [ "print \"" <> action <> " " <> resultName r <> "...\";" + | let action = case resultType r of + ProveProperty -> "Proving" + CheckProperty -> "Checking" + Counterexample -> "Disproving" + ] ++ + if resultHasRoundingMode r + then [basicCommand (" " <> rm) | rm <- roundingModes] + else [basicCommand ""] + where + -- We arbitrarily instantiate each property at Float32 (`{8, 24}), but + -- these properties should hold for any Float size. + basicCommand :: Text -> Text + basicCommand rm = + command <> " {{ " <> resultName r <> "`{8, 24}" <> rm <> " }};" + where + command = case resultType r of + ProveProperty -> "prove_print " <> prover + CheckProperty -> "prove_print " <> quickcheck + Counterexample -> "sat_print " <> prover + + roundingModes :: [Text] + roundingModes = ["rne", "rna", "rtp", "rtn", "rtz"] + + prover, quickcheck :: Text + prover = "(w4_unint_bitwuzla [])" -- A reasonably fast solver for floating-point-related properties + quickcheck = "(quickcheck 100)" + +main :: IO () +main = do + results <- scrapeResults + T.putStrLn $ T.unlines $ + [ "// THIS IS AUTO-GENERATED" + , "//" + , "// Rather than modifying this file, please modify the script which" + , "// generated it (" <> T.pack scriptFile <> ") and regenerate it using:" + , "//" + , "// runghc " <> T.pack scriptFile <> " > " <> T.pack sawFile + , "" + , "import Float;" + , "import " <> T.pack (dropExtension propertiesFile) <> ";" + ] ++ + concatMap resultCommandLines results diff --git a/intTests/test1237_properties/test.saw b/intTests/test1237_properties/test.saw new file mode 100644 index 0000000000..5c67b10532 --- /dev/null +++ b/intTests/test1237_properties/test.saw @@ -0,0 +1,572 @@ +// THIS IS AUTO-GENERATED +// +// Rather than modifying this file, please modify the script which +// generated it (GenFloatProperties.hs) and regenerate it using: +// +// runghc GenFloatProperties.hs > test.saw + +import Float; +import FloatPropertiesGeneric; +print "Proving prop_fpNaNIsNaN..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpNaNIsNaN`{8, 24} }}; +print "Proving prop_fpNaNIsNotInf..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpNaNIsNotInf`{8, 24} }}; +print "Proving prop_fpNaNIsNotZero..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpNaNIsNotZero`{8, 24} }}; +print "Proving prop_fpNaNIsNotNormal..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpNaNIsNotNormal`{8, 24} }}; +print "Proving prop_fpNaNIsNotSubnormal..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpNaNIsNotSubnormal`{8, 24} }}; +print "Proving prop_fpNaNExponentAllOneBits..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpNaNExponentAllOneBits`{8, 24} }}; +print "Proving prop_fpNaNSignificandAtLeastOneBit..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpNaNSignificandAtLeastOneBit`{8, 24} }}; +print "Proving prop_fpPosInfIsPos..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpPosInfIsPos`{8, 24} }}; +print "Proving prop_fpPosInfIsInf..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpPosInfIsInf`{8, 24} }}; +print "Proving prop_fpPosInfIsNotZero..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpPosInfIsNotZero`{8, 24} }}; +print "Proving prop_fpPosInfIsNotNaN..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpPosInfIsNotNaN`{8, 24} }}; +print "Proving prop_fpPosInfIsNotNormal..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpPosInfIsNotNormal`{8, 24} }}; +print "Proving prop_fpPosInfIsNotSubnormal..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpPosInfIsNotSubnormal`{8, 24} }}; +print "Proving prop_fpNegInfIsNeg..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpNegInfIsNeg`{8, 24} }}; +print "Proving prop_fpNegInfIsInf..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpNegInfIsInf`{8, 24} }}; +print "Proving prop_fpNegInfIsNotZero..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpNegInfIsNotZero`{8, 24} }}; +print "Proving prop_fpNegInfIsNotNaN..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpNegInfIsNotNaN`{8, 24} }}; +print "Proving prop_fpNegInfIsNotNormal..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpNegInfIsNotNormal`{8, 24} }}; +print "Proving prop_fpNegInfIsNotSubnormal..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpNegInfIsNotSubnormal`{8, 24} }}; +print "Proving prop_fpPosZeroIsPos..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpPosZeroIsPos`{8, 24} }}; +print "Proving prop_fpPosZeroIsZero..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpPosZeroIsZero`{8, 24} }}; +print "Proving prop_fpPosZeroIsNotNaN..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpPosZeroIsNotNaN`{8, 24} }}; +print "Proving prop_fpPosZeroIsNotInf..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpPosZeroIsNotInf`{8, 24} }}; +print "Proving prop_fpPosZeroIsNotNormal..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpPosZeroIsNotNormal`{8, 24} }}; +print "Proving prop_fpPosZeroIsNotSubnormal..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpPosZeroIsNotSubnormal`{8, 24} }}; +print "Proving prop_fpNegZeroIsNeg..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpNegZeroIsNeg`{8, 24} }}; +print "Proving prop_fpNegZeroIsZero..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpNegZeroIsZero`{8, 24} }}; +print "Proving prop_fpNegZeroIsNotNaN..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpNegZeroIsNotNaN`{8, 24} }}; +print "Proving prop_fpNegZeroIsNotInf..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpNegZeroIsNotInf`{8, 24} }}; +print "Proving prop_fpNegZeroIsNotNormal..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpNegZeroIsNotNormal`{8, 24} }}; +print "Proving prop_fpNegZeroIsNotSubnormal..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpNegZeroIsNotSubnormal`{8, 24} }}; +print "Proving prop_fpFromToBits..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpFromToBits`{8, 24} }}; +print "Proving prop_fpToFromBits..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpToFromBits`{8, 24} }}; +print "Proving prop_fpFromBitsCorrect..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpFromBitsCorrect`{8, 24} }}; +print "Proving prop_fpFromBitsEq..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpFromBitsEq`{8, 24} }}; +print "Proving prop_fpToBitsCorrect..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpToBitsCorrect`{8, 24} }}; +print "Proving prop_fpToBitsEq..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpToBitsEq`{8, 24} }}; +print "Proving prop_fpLogicalEqNaN..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpLogicalEqNaN`{8, 24} }}; +print "Proving prop_fpLogicalEqZero..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpLogicalEqZero`{8, 24} }}; +print "Proving prop_fpLogicalEqToIeeeEq..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpLogicalEqToIeeeEq`{8, 24} }}; +print "Proving prop_fpIeeeEqToLogicalEq..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpIeeeEqToLogicalEq`{8, 24} }}; +print "Proving prop_fpLogicalEqReflexive..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpLogicalEqReflexive`{8, 24} }}; +print "Proving prop_fpLogicalEqSymmetric..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpLogicalEqSymmetric`{8, 24} }}; +print "Proving prop_fpLogicalEqTransitive..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpLogicalEqTransitive`{8, 24} }}; +print "Proving prop_fpIsPosSign..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpIsPosSign`{8, 24} }}; +print "Proving prop_fpIsNegSign..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpIsNegSign`{8, 24} }}; +print "Proving prop_fpIsNormalCorrect..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpIsNormalCorrect`{8, 24} }}; +print "Proving prop_fpAddNaN..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpAddNaN`{8, 24} rne }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpAddNaN`{8, 24} rna }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpAddNaN`{8, 24} rtp }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpAddNaN`{8, 24} rtn }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpAddNaN`{8, 24} rtz }}; +print "Proving prop_fpAddPosNegInf..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpAddPosNegInf`{8, 24} rne }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpAddPosNegInf`{8, 24} rna }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpAddPosNegInf`{8, 24} rtp }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpAddPosNegInf`{8, 24} rtn }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpAddPosNegInf`{8, 24} rtz }}; +print "Proving prop_fpAddNegPosInf..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpAddNegPosInf`{8, 24} rne }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpAddNegPosInf`{8, 24} rna }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpAddNegPosInf`{8, 24} rtp }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpAddNegPosInf`{8, 24} rtn }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpAddNegPosInf`{8, 24} rtz }}; +print "Proving prop_fpAddLeftInf..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpAddLeftInf`{8, 24} rne }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpAddLeftInf`{8, 24} rna }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpAddLeftInf`{8, 24} rtp }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpAddLeftInf`{8, 24} rtn }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpAddLeftInf`{8, 24} rtz }}; +print "Proving prop_fpAddRightInf..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpAddRightInf`{8, 24} rne }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpAddRightInf`{8, 24} rna }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpAddRightInf`{8, 24} rtp }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpAddRightInf`{8, 24} rtn }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpAddRightInf`{8, 24} rtz }}; +print "Proving prop_fpAddLeftIdentity..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpAddLeftIdentity`{8, 24} rne }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpAddLeftIdentity`{8, 24} rna }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpAddLeftIdentity`{8, 24} rtp }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpAddLeftIdentity`{8, 24} rtn }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpAddLeftIdentity`{8, 24} rtz }}; +print "Proving prop_fpAddRightIdentity..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpAddRightIdentity`{8, 24} rne }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpAddRightIdentity`{8, 24} rna }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpAddRightIdentity`{8, 24} rtp }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpAddRightIdentity`{8, 24} rtn }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpAddRightIdentity`{8, 24} rtz }}; +print "Proving prop_fpAddCommutative..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpAddCommutative`{8, 24} rne }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpAddCommutative`{8, 24} rna }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpAddCommutative`{8, 24} rtp }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpAddCommutative`{8, 24} rtn }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpAddCommutative`{8, 24} rtz }}; +print "Proving prop_fpAddInverse..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpAddInverse`{8, 24} rne }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpAddInverse`{8, 24} rna }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpAddInverse`{8, 24} rtp }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpAddInverse`{8, 24} rtn }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpAddInverse`{8, 24} rtz }}; +print "Disproving counterexample_fpAddAssociative..."; +sat_print (w4_unint_bitwuzla []) {{ counterexample_fpAddAssociative`{8, 24} rne }}; +sat_print (w4_unint_bitwuzla []) {{ counterexample_fpAddAssociative`{8, 24} rna }}; +sat_print (w4_unint_bitwuzla []) {{ counterexample_fpAddAssociative`{8, 24} rtp }}; +sat_print (w4_unint_bitwuzla []) {{ counterexample_fpAddAssociative`{8, 24} rtn }}; +sat_print (w4_unint_bitwuzla []) {{ counterexample_fpAddAssociative`{8, 24} rtz }}; +print "Proving prop_fpSubNaN..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpSubNaN`{8, 24} rne }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpSubNaN`{8, 24} rna }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpSubNaN`{8, 24} rtp }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpSubNaN`{8, 24} rtn }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpSubNaN`{8, 24} rtz }}; +print "Proving prop_fpSubPosPosInf..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpSubPosPosInf`{8, 24} rne }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpSubPosPosInf`{8, 24} rna }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpSubPosPosInf`{8, 24} rtp }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpSubPosPosInf`{8, 24} rtn }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpSubPosPosInf`{8, 24} rtz }}; +print "Proving prop_fpSubNegNegInf..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpSubNegNegInf`{8, 24} rne }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpSubNegNegInf`{8, 24} rna }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpSubNegNegInf`{8, 24} rtp }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpSubNegNegInf`{8, 24} rtn }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpSubNegNegInf`{8, 24} rtz }}; +print "Proving prop_fpSubLeftInf..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpSubLeftInf`{8, 24} rne }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpSubLeftInf`{8, 24} rna }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpSubLeftInf`{8, 24} rtp }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpSubLeftInf`{8, 24} rtn }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpSubLeftInf`{8, 24} rtz }}; +print "Proving prop_fpSubRightInf..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpSubRightInf`{8, 24} rne }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpSubRightInf`{8, 24} rna }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpSubRightInf`{8, 24} rtp }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpSubRightInf`{8, 24} rtn }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpSubRightInf`{8, 24} rtz }}; +print "Proving prop_fpSubZeroLeft..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpSubZeroLeft`{8, 24} rne }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpSubZeroLeft`{8, 24} rna }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpSubZeroLeft`{8, 24} rtp }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpSubZeroLeft`{8, 24} rtn }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpSubZeroLeft`{8, 24} rtz }}; +print "Proving prop_fpSubZeroRight..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpSubZeroRight`{8, 24} rne }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpSubZeroRight`{8, 24} rna }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpSubZeroRight`{8, 24} rtp }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpSubZeroRight`{8, 24} rtn }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpSubZeroRight`{8, 24} rtz }}; +print "Proving prop_fpSubPosPos..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpSubPosPos`{8, 24} rne }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpSubPosPos`{8, 24} rna }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpSubPosPos`{8, 24} rtp }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpSubPosPos`{8, 24} rtn }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpSubPosPos`{8, 24} rtz }}; +print "Proving prop_fpSubNegAdd..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpSubNegAdd`{8, 24} rne }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpSubNegAdd`{8, 24} rna }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpSubNegAdd`{8, 24} rtp }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpSubNegAdd`{8, 24} rtn }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpSubNegAdd`{8, 24} rtz }}; +print "Proving prop_fpAddNegSub..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpAddNegSub`{8, 24} rne }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpAddNegSub`{8, 24} rna }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpAddNegSub`{8, 24} rtp }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpAddNegSub`{8, 24} rtn }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpAddNegSub`{8, 24} rtz }}; +print "Proving prop_fpSubAnticommutative..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpSubAnticommutative`{8, 24} rne }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpSubAnticommutative`{8, 24} rna }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpSubAnticommutative`{8, 24} rtp }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpSubAnticommutative`{8, 24} rtn }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpSubAnticommutative`{8, 24} rtz }}; +print "Proving prop_fpSubSelfInverse..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpSubSelfInverse`{8, 24} rne }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpSubSelfInverse`{8, 24} rna }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpSubSelfInverse`{8, 24} rtp }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpSubSelfInverse`{8, 24} rtn }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpSubSelfInverse`{8, 24} rtz }}; +print "Proving prop_fpMulNaN..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpMulNaN`{8, 24} rne }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpMulNaN`{8, 24} rna }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpMulNaN`{8, 24} rtp }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpMulNaN`{8, 24} rtn }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpMulNaN`{8, 24} rtz }}; +print "Proving prop_fpMulZeroInf..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpMulZeroInf`{8, 24} rne }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpMulZeroInf`{8, 24} rna }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpMulZeroInf`{8, 24} rtp }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpMulZeroInf`{8, 24} rtn }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpMulZeroInf`{8, 24} rtz }}; +print "Proving prop_fpMulInfZero..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpMulInfZero`{8, 24} rne }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpMulInfZero`{8, 24} rna }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpMulInfZero`{8, 24} rtp }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpMulInfZero`{8, 24} rtn }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpMulInfZero`{8, 24} rtz }}; +print "Proving prop_fpMulLeftInf..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpMulLeftInf`{8, 24} rne }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpMulLeftInf`{8, 24} rna }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpMulLeftInf`{8, 24} rtp }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpMulLeftInf`{8, 24} rtn }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpMulLeftInf`{8, 24} rtz }}; +print "Proving prop_fpMulRightInf..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpMulRightInf`{8, 24} rne }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpMulRightInf`{8, 24} rna }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpMulRightInf`{8, 24} rtp }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpMulRightInf`{8, 24} rtn }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpMulRightInf`{8, 24} rtz }}; +print "Proving prop_fpMulLeftIdentity..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpMulLeftIdentity`{8, 24} rne }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpMulLeftIdentity`{8, 24} rna }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpMulLeftIdentity`{8, 24} rtp }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpMulLeftIdentity`{8, 24} rtn }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpMulLeftIdentity`{8, 24} rtz }}; +print "Proving prop_fpMulRightIdentity..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpMulRightIdentity`{8, 24} rne }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpMulRightIdentity`{8, 24} rna }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpMulRightIdentity`{8, 24} rtp }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpMulRightIdentity`{8, 24} rtn }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpMulRightIdentity`{8, 24} rtz }}; +print "Proving prop_fpMulLeftPosZero..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpMulLeftPosZero`{8, 24} rne }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpMulLeftPosZero`{8, 24} rna }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpMulLeftPosZero`{8, 24} rtp }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpMulLeftPosZero`{8, 24} rtn }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpMulLeftPosZero`{8, 24} rtz }}; +print "Proving prop_fpMulRightPosZero..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpMulRightPosZero`{8, 24} rne }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpMulRightPosZero`{8, 24} rna }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpMulRightPosZero`{8, 24} rtp }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpMulRightPosZero`{8, 24} rtn }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpMulRightPosZero`{8, 24} rtz }}; +print "Proving prop_fpMulLeftNegZero..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpMulLeftNegZero`{8, 24} rne }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpMulLeftNegZero`{8, 24} rna }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpMulLeftNegZero`{8, 24} rtp }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpMulLeftNegZero`{8, 24} rtn }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpMulLeftNegZero`{8, 24} rtz }}; +print "Proving prop_fpMulRightNegZero..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpMulRightNegZero`{8, 24} rne }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpMulRightNegZero`{8, 24} rna }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpMulRightNegZero`{8, 24} rtp }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpMulRightNegZero`{8, 24} rtn }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpMulRightNegZero`{8, 24} rtz }}; +print "Proving prop_fpMulNegNeg..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpMulNegNeg`{8, 24} rne }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpMulNegNeg`{8, 24} rna }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpMulNegNeg`{8, 24} rtp }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpMulNegNeg`{8, 24} rtn }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpMulNegNeg`{8, 24} rtz }}; +print "Proving prop_fpMulPosPos..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpMulPosPos`{8, 24} rne }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpMulPosPos`{8, 24} rna }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpMulPosPos`{8, 24} rtp }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpMulPosPos`{8, 24} rtn }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpMulPosPos`{8, 24} rtz }}; +print "Proving prop_fpMulNegPos..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpMulNegPos`{8, 24} rne }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpMulNegPos`{8, 24} rna }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpMulNegPos`{8, 24} rtp }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpMulNegPos`{8, 24} rtn }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpMulNegPos`{8, 24} rtz }}; +print "Proving prop_fpMulPosNeg..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpMulPosNeg`{8, 24} rne }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpMulPosNeg`{8, 24} rna }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpMulPosNeg`{8, 24} rtp }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpMulPosNeg`{8, 24} rtn }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpMulPosNeg`{8, 24} rtz }}; +print "Proving prop_fpMulCommutative..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpMulCommutative`{8, 24} rne }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpMulCommutative`{8, 24} rna }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpMulCommutative`{8, 24} rtp }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpMulCommutative`{8, 24} rtn }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpMulCommutative`{8, 24} rtz }}; +print "Disproving counterexample_fpMulAssociative..."; +sat_print (w4_unint_bitwuzla []) {{ counterexample_fpMulAssociative`{8, 24} rne }}; +sat_print (w4_unint_bitwuzla []) {{ counterexample_fpMulAssociative`{8, 24} rna }}; +sat_print (w4_unint_bitwuzla []) {{ counterexample_fpMulAssociative`{8, 24} rtp }}; +sat_print (w4_unint_bitwuzla []) {{ counterexample_fpMulAssociative`{8, 24} rtn }}; +sat_print (w4_unint_bitwuzla []) {{ counterexample_fpMulAssociative`{8, 24} rtz }}; +print "Disproving counterexample_fpMulDistributive..."; +sat_print (w4_unint_bitwuzla []) {{ counterexample_fpMulDistributive`{8, 24} rne }}; +sat_print (w4_unint_bitwuzla []) {{ counterexample_fpMulDistributive`{8, 24} rna }}; +sat_print (w4_unint_bitwuzla []) {{ counterexample_fpMulDistributive`{8, 24} rtp }}; +sat_print (w4_unint_bitwuzla []) {{ counterexample_fpMulDistributive`{8, 24} rtn }}; +sat_print (w4_unint_bitwuzla []) {{ counterexample_fpMulDistributive`{8, 24} rtz }}; +print "Proving prop_fpDivNaN..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpDivNaN`{8, 24} rne }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpDivNaN`{8, 24} rna }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpDivNaN`{8, 24} rtp }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpDivNaN`{8, 24} rtn }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpDivNaN`{8, 24} rtz }}; +print "Proving prop_fpDivInfInf..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpDivInfInf`{8, 24} rne }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpDivInfInf`{8, 24} rna }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpDivInfInf`{8, 24} rtp }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpDivInfInf`{8, 24} rtn }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpDivInfInf`{8, 24} rtz }}; +print "Proving prop_fpDivPosInfDividend..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpDivPosInfDividend`{8, 24} rne }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpDivPosInfDividend`{8, 24} rna }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpDivPosInfDividend`{8, 24} rtp }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpDivPosInfDividend`{8, 24} rtn }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpDivPosInfDividend`{8, 24} rtz }}; +print "Proving prop_fpDivNegInfDividend..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpDivNegInfDividend`{8, 24} rne }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpDivNegInfDividend`{8, 24} rna }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpDivNegInfDividend`{8, 24} rtp }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpDivNegInfDividend`{8, 24} rtn }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpDivNegInfDividend`{8, 24} rtz }}; +print "Proving prop_fpDivPosInfDivisor..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpDivPosInfDivisor`{8, 24} rne }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpDivPosInfDivisor`{8, 24} rna }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpDivPosInfDivisor`{8, 24} rtp }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpDivPosInfDivisor`{8, 24} rtn }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpDivPosInfDivisor`{8, 24} rtz }}; +print "Proving prop_fpDivNegInfDivisor..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpDivNegInfDivisor`{8, 24} rne }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpDivNegInfDivisor`{8, 24} rna }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpDivNegInfDivisor`{8, 24} rtp }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpDivNegInfDivisor`{8, 24} rtn }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpDivNegInfDivisor`{8, 24} rtz }}; +print "Proving prop_fpDivPosZeroDividend..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpDivPosZeroDividend`{8, 24} rne }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpDivPosZeroDividend`{8, 24} rna }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpDivPosZeroDividend`{8, 24} rtp }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpDivPosZeroDividend`{8, 24} rtn }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpDivPosZeroDividend`{8, 24} rtz }}; +print "Proving prop_fpDivNegZeroDividend..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpDivNegZeroDividend`{8, 24} rne }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpDivNegZeroDividend`{8, 24} rna }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpDivNegZeroDividend`{8, 24} rtp }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpDivNegZeroDividend`{8, 24} rtn }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpDivNegZeroDividend`{8, 24} rtz }}; +print "Proving prop_fpDivPosZeroDivisor..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpDivPosZeroDivisor`{8, 24} rne }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpDivPosZeroDivisor`{8, 24} rna }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpDivPosZeroDivisor`{8, 24} rtp }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpDivPosZeroDivisor`{8, 24} rtn }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpDivPosZeroDivisor`{8, 24} rtz }}; +print "Proving prop_fpDivNegZeroDivisor..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpDivNegZeroDivisor`{8, 24} rne }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpDivNegZeroDivisor`{8, 24} rna }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpDivNegZeroDivisor`{8, 24} rtp }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpDivNegZeroDivisor`{8, 24} rtn }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpDivNegZeroDivisor`{8, 24} rtz }}; +print "Proving prop_fpDivOne..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpDivOne`{8, 24} rne }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpDivOne`{8, 24} rna }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpDivOne`{8, 24} rtp }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpDivOne`{8, 24} rtn }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpDivOne`{8, 24} rtz }}; +print "Proving prop_fpDivInverse..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpDivInverse`{8, 24} rne }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpDivInverse`{8, 24} rna }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpDivInverse`{8, 24} rtp }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpDivInverse`{8, 24} rtn }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpDivInverse`{8, 24} rtz }}; +print "Disproving counterexample_fpDivDistributive..."; +sat_print (w4_unint_bitwuzla []) {{ counterexample_fpDivDistributive`{8, 24} rne }}; +sat_print (w4_unint_bitwuzla []) {{ counterexample_fpDivDistributive`{8, 24} rna }}; +sat_print (w4_unint_bitwuzla []) {{ counterexample_fpDivDistributive`{8, 24} rtp }}; +sat_print (w4_unint_bitwuzla []) {{ counterexample_fpDivDistributive`{8, 24} rtn }}; +sat_print (w4_unint_bitwuzla []) {{ counterexample_fpDivDistributive`{8, 24} rtz }}; +print "Proving prop_fpFMACommutative..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpFMACommutative`{8, 24} rne }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpFMACommutative`{8, 24} rna }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpFMACommutative`{8, 24} rtp }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpFMACommutative`{8, 24} rtn }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpFMACommutative`{8, 24} rtz }}; +print "Disproving counterexample_fpFMAAssociative..."; +sat_print (w4_unint_bitwuzla []) {{ counterexample_fpFMAAssociative`{8, 24} rne }}; +sat_print (w4_unint_bitwuzla []) {{ counterexample_fpFMAAssociative`{8, 24} rna }}; +sat_print (w4_unint_bitwuzla []) {{ counterexample_fpFMAAssociative`{8, 24} rtp }}; +sat_print (w4_unint_bitwuzla []) {{ counterexample_fpFMAAssociative`{8, 24} rtn }}; +sat_print (w4_unint_bitwuzla []) {{ counterexample_fpFMAAssociative`{8, 24} rtz }}; +print "Disproving counterexample_fpFMAExpand..."; +sat_print (w4_unint_bitwuzla []) {{ counterexample_fpFMAExpand`{8, 24} rne }}; +sat_print (w4_unint_bitwuzla []) {{ counterexample_fpFMAExpand`{8, 24} rna }}; +sat_print (w4_unint_bitwuzla []) {{ counterexample_fpFMAExpand`{8, 24} rtp }}; +sat_print (w4_unint_bitwuzla []) {{ counterexample_fpFMAExpand`{8, 24} rtn }}; +sat_print (w4_unint_bitwuzla []) {{ counterexample_fpFMAExpand`{8, 24} rtz }}; +print "Proving prop_fpAbsZero..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpAbsZero`{8, 24} }}; +print "Proving prop_fpAbsPos..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpAbsPos`{8, 24} }}; +print "Proving prop_fpAbsNeg..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpAbsNeg`{8, 24} }}; +print "Proving prop_fpAbsNaN..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpAbsNaN`{8, 24} }}; +print "Proving prop_fpAbsInf..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpAbsInf`{8, 24} }}; +print "Proving prop_fpSqrtNaN..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpSqrtNaN`{8, 24} rne }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpSqrtNaN`{8, 24} rna }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpSqrtNaN`{8, 24} rtp }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpSqrtNaN`{8, 24} rtn }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpSqrtNaN`{8, 24} rtz }}; +print "Proving prop_fpSqrtPosInf..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpSqrtPosInf`{8, 24} rne }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpSqrtPosInf`{8, 24} rna }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpSqrtPosInf`{8, 24} rtp }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpSqrtPosInf`{8, 24} rtn }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpSqrtPosInf`{8, 24} rtz }}; +print "Proving prop_fpSqrtPosZero..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpSqrtPosZero`{8, 24} rne }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpSqrtPosZero`{8, 24} rna }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpSqrtPosZero`{8, 24} rtp }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpSqrtPosZero`{8, 24} rtn }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpSqrtPosZero`{8, 24} rtz }}; +print "Proving prop_fpSqrtNegZero..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpSqrtNegZero`{8, 24} rne }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpSqrtNegZero`{8, 24} rna }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpSqrtNegZero`{8, 24} rtp }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpSqrtNegZero`{8, 24} rtn }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpSqrtNegZero`{8, 24} rtz }}; +print "Proving prop_fpSqrtNeg..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpSqrtNeg`{8, 24} rne }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpSqrtNeg`{8, 24} rna }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpSqrtNeg`{8, 24} rtp }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpSqrtNeg`{8, 24} rtn }}; +prove_print (w4_unint_bitwuzla []) {{ prop_fpSqrtNeg`{8, 24} rtz }}; +print "Disproving counterexample_fpSqrtMul..."; +sat_print (w4_unint_bitwuzla []) {{ counterexample_fpSqrtMul`{8, 24} rne }}; +sat_print (w4_unint_bitwuzla []) {{ counterexample_fpSqrtMul`{8, 24} rna }}; +sat_print (w4_unint_bitwuzla []) {{ counterexample_fpSqrtMul`{8, 24} rtp }}; +sat_print (w4_unint_bitwuzla []) {{ counterexample_fpSqrtMul`{8, 24} rtn }}; +sat_print (w4_unint_bitwuzla []) {{ counterexample_fpSqrtMul`{8, 24} rtz }}; +print "Disproving counterexample_fpSqrtDiv..."; +sat_print (w4_unint_bitwuzla []) {{ counterexample_fpSqrtDiv`{8, 24} rne }}; +sat_print (w4_unint_bitwuzla []) {{ counterexample_fpSqrtDiv`{8, 24} rna }}; +sat_print (w4_unint_bitwuzla []) {{ counterexample_fpSqrtDiv`{8, 24} rtp }}; +sat_print (w4_unint_bitwuzla []) {{ counterexample_fpSqrtDiv`{8, 24} rtn }}; +sat_print (w4_unint_bitwuzla []) {{ counterexample_fpSqrtDiv`{8, 24} rtz }}; +print "Disproving counterexample_fpSqrtSquare..."; +sat_print (w4_unint_bitwuzla []) {{ counterexample_fpSqrtSquare`{8, 24} rne }}; +sat_print (w4_unint_bitwuzla []) {{ counterexample_fpSqrtSquare`{8, 24} rna }}; +sat_print (w4_unint_bitwuzla []) {{ counterexample_fpSqrtSquare`{8, 24} rtp }}; +sat_print (w4_unint_bitwuzla []) {{ counterexample_fpSqrtSquare`{8, 24} rtn }}; +sat_print (w4_unint_bitwuzla []) {{ counterexample_fpSqrtSquare`{8, 24} rtz }}; +print "Disproving counterexample_fpSqrtSquared..."; +sat_print (w4_unint_bitwuzla []) {{ counterexample_fpSqrtSquared`{8, 24} rne }}; +sat_print (w4_unint_bitwuzla []) {{ counterexample_fpSqrtSquared`{8, 24} rna }}; +sat_print (w4_unint_bitwuzla []) {{ counterexample_fpSqrtSquared`{8, 24} rtp }}; +sat_print (w4_unint_bitwuzla []) {{ counterexample_fpSqrtSquared`{8, 24} rtn }}; +sat_print (w4_unint_bitwuzla []) {{ counterexample_fpSqrtSquared`{8, 24} rtz }}; +print "Checking check_fpFromToRational..."; +prove_print (quickcheck 100) {{ check_fpFromToRational`{8, 24} rne }}; +prove_print (quickcheck 100) {{ check_fpFromToRational`{8, 24} rna }}; +prove_print (quickcheck 100) {{ check_fpFromToRational`{8, 24} rtp }}; +prove_print (quickcheck 100) {{ check_fpFromToRational`{8, 24} rtn }}; +prove_print (quickcheck 100) {{ check_fpFromToRational`{8, 24} rtz }}; +print "Proving prop_fpEqNaN..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpEqNaN`{8, 24} }}; +print "Proving prop_fpEqZero..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpEqZero`{8, 24} }}; +print "Proving prop_fpEqReflexive..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpEqReflexive`{8, 24} }}; +print "Proving prop_fpEqSymmetric..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpEqSymmetric`{8, 24} }}; +print "Proving prop_fpEqTransitive..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpEqTransitive`{8, 24} }}; +print "Proving prop_fpCmpNaN..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpCmpNaN`{8, 24} }}; +print "Proving prop_fpCmpZero..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpCmpZero`{8, 24} }}; +print "Proving prop_fpCmpLtIrreflexive..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpCmpLtIrreflexive`{8, 24} }}; +print "Proving prop_fpCmpLtAsymmetric..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpCmpLtAsymmetric`{8, 24} }}; +print "Proving prop_fpCmpLtTransitive..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpCmpLtTransitive`{8, 24} }}; +print "Proving prop_fpCmpLeReflexive..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpCmpLeReflexive`{8, 24} }}; +print "Proving prop_fpCmpLeAntisymmetric..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpCmpLeAntisymmetric`{8, 24} }}; +print "Proving prop_fpCmpLeTransitive..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpCmpLeTransitive`{8, 24} }}; +print "Proving prop_fpCmpLeTotal..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpCmpLeTotal`{8, 24} }}; +print "Proving prop_fpCmpGtCorrect..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpCmpGtCorrect`{8, 24} }}; +print "Proving prop_fpCmpGeCorrect..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpCmpGeCorrect`{8, 24} }}; +print "Proving prop_fpZero..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpZero`{8, 24} }}; +print "Proving prop_fpRingAdd..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpRingAdd`{8, 24} }}; +print "Proving prop_fpRingSub..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpRingSub`{8, 24} }}; +print "Proving prop_fpRingMul..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpRingMul`{8, 24} }}; +print "Proving prop_fpRingNegate..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpRingNegate`{8, 24} }}; +print "Proving prop_fpFieldDiv..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpFieldDiv`{8, 24} }}; +print "Proving prop_fpFieldRecip..."; +prove_print (w4_unint_bitwuzla []) {{ prop_fpFieldRecip`{8, 24} }}; +print "Checking check_fpRoundFloorCeiling..."; +prove_print (quickcheck 100) {{ check_fpRoundFloorCeiling`{8, 24} }}; +print "Checking check_fpRoundCeilingFloor..."; +prove_print (quickcheck 100) {{ check_fpRoundCeilingFloor`{8, 24} }}; +print "Checking check_fpRoundFloorCorrect..."; +prove_print (quickcheck 100) {{ check_fpRoundFloorCorrect`{8, 24} }}; +print "Checking check_fpRoundCeilingCorrect..."; +prove_print (quickcheck 100) {{ check_fpRoundCeilingCorrect`{8, 24} }}; +print "Checking check_fpRoundTruncCeilingFloor..."; +prove_print (quickcheck 100) {{ check_fpRoundTruncCeilingFloor`{8, 24} }}; +print "Checking check_fpRoundTruncCorrect..."; +prove_print (quickcheck 100) {{ check_fpRoundTruncCorrect`{8, 24} }}; +print "Checking check_fpRoundAwayTrunc..."; +prove_print (quickcheck 100) {{ check_fpRoundAwayTrunc`{8, 24} }}; +print "Checking check_fpRoundAwayCorrect..."; +prove_print (quickcheck 100) {{ check_fpRoundAwayCorrect`{8, 24} }}; + diff --git a/intTests/test1237_properties/test.sh b/intTests/test1237_properties/test.sh new file mode 100644 index 0000000000..2315cc233c --- /dev/null +++ b/intTests/test1237_properties/test.sh @@ -0,0 +1,3 @@ +set -e + +$SAW test.saw diff --git a/intTests/test1237_unit_tests/test.saw b/intTests/test1237_unit_tests/test.saw new file mode 100644 index 0000000000..80281c2298 --- /dev/null +++ b/intTests/test1237_unit_tests/test.saw @@ -0,0 +1,131 @@ +// Non-symbolic unit tests involving Cryptol's Float module. + +import Float; + +let prove_it = prove_print (w4_unint_cvc5 []); + +// fpFromBits +prove_it {{ fpFromBits 0x40D03A98FB4D2934 == (16618.390338220823 : Float64) }}; + +// fpToBits +prove_it {{ fpToBits (16618.390338220823 : Float64) == 0x40d03a98fb4d2934 }}; + +// (=.=) +prove_it {{ (25.0 : Float64) =.= 25.0 }}; +prove_it {{ (fpNaN : Float64) =.= fpNaN }}; +prove_it {{ ~ ((fpPosZero : Float64) =.= fpNegZero) }}; + +// fpIsNaN +prove_it {{ fpIsNaN (fpNaN : Float64) }}; +prove_it {{ ~ fpIsNaN (25.0 : Float64) }}; + +// fpIsInf +prove_it {{ fpIsInf (fpPosInf : Float64) }}; +prove_it {{ ~ fpIsInf (25.0 : Float64) }}; + +// fpIsFinite +prove_it {{ fpIsFinite (25.0 : Float64) }}; +prove_it {{ ~ fpIsFinite (fpPosInf : Float64) }}; + +// fpIsNeg +prove_it {{ fpIsNeg (-25.0 : Float64) }}; +prove_it {{ ~ fpIsNeg (25.0 : Float64) }}; + +// fpIsNormal +prove_it {{ fpIsNormal (25.0 : Float64) }}; +prove_it {{ ~ fpIsNormal (4.9406564584124654e-324 : Float64) }}; + +// fpIsSubnormal +prove_it {{ fpIsSubnormal (4.9406564584124654e-324 : Float64) }}; +prove_it {{ ~ fpIsSubnormal (25.0 : Float64) }}; + +// fpAdd +prove_it {{ fpAdd rne (2.5 : Float64) 3.0 == 5.5 }}; + +// fpSub +prove_it {{ fpSub rne (2.5 : Float64) 3.0 == -0.5 }}; + +// fpMul +prove_it {{ fpMul rne (2.5 : Float64) 3.0 == 7.5 }}; + +// fpDiv +prove_it {{ fpDiv rne (2.5 : Float64) 3.0 == 0.83333333333333337 }}; + +// fpFMA +prove_it {{ fpFMA rne (2.5 : Float64) 3.0 3.5 == 11 }}; + +// fpAbs +prove_it {{ fpAbs (-25.0 : Float64) == 25.0 }}; + +// fpSqrt +prove_it {{ fpSqrt rne (25.0 : Float64) == 5.0 }}; + +// fpFromRational +prove_it {{ fpFromRational rne (ratio 5 2) == (2.5 : Float64) }}; + +// Eq instance +prove_it {{ (1.5 : Float64) == 1.5 }}; +prove_it {{ (fpPosZero : Float64) == fpNegZero }}; +prove_it {{ (fpNaN : Float64) != fpNaN }}; + +// Cmp instance +prove_it {{ (1.5 : Float64) < 2.5 }}; +prove_it {{ (1.5 : Float64) <= 2.5 }}; +prove_it {{ (2.5 : Float64) > 1.5 }}; +prove_it {{ (2.5 : Float64) >= 1.5 }}; +prove_it {{ ~ ((fpPosZero : Float64) < fpNegZero) }}; +prove_it {{ ~ ((fpNegZero : Float64) < fpPosZero) }}; +prove_it {{ ~ ((fpPosZero : Float64) > fpNegZero) }}; +prove_it {{ ~ ((fpNegZero : Float64) > fpPosZero) }}; +prove_it {{ (fpPosZero : Float64) <= fpNegZero }}; +prove_it {{ (fpNegZero : Float64) <= fpPosZero }}; +prove_it {{ (fpPosZero : Float64) >= fpNegZero }}; +prove_it {{ (fpNegZero : Float64) >= fpPosZero }}; +prove_it {{ ~ ((fpNaN : Float64) < fpNaN) }}; +prove_it {{ ~ ((fpNaN : Float64) <= fpNaN) }}; +prove_it {{ ~ ((fpNaN : Float64) > fpNaN) }}; +prove_it {{ ~ ((fpNaN : Float64) >= fpNaN) }}; + +// Zero instance +prove_it {{ (zero : Float64) == fpPosZero }}; + +// Ring instance +prove_it {{ (fromInteger 25 : Float64) == 25.0 }}; + +// Field instance +prove_it {{ recip (2.0 : Float64) == 0.5 }}; + +// Round instance +prove_it {{ floor (3.5 : Float64) == 3 }}; +prove_it {{ ceiling (3.5 : Float64) == 4 }}; +prove_it {{ trunc (3.5 : Float64) == 3 }}; +prove_it {{ roundToEven (3.5 : Float64) == 4 }}; +prove_it {{ roundAway (3.5 : Float64) == 4 }}; + +// The following operations do not yet have Cryptol counterparts (see +// https://github.com/GaloisInc/cryptol/issues/2046), so we use parse_core to +// write them directly in SAWCore. + +// fpIsPos +// {{ fpIsPos (25 : Float64) }} +prove_it (parse_core "EqTrue (fpIsPos 11 53 (fpFromInteger 11 53 rne (natToInt 25)))"); + +// fpRem +// {{ fpRem (4 : Float64) 3 == 1 }} +prove_it (parse_core "EqTrue (fpIeeeEq 11 53 (fpRem 11 53 (fpFromInteger 11 53 rne (natToInt 4)) (fpFromInteger 11 53 rne (natToInt 3))) (fpFromInteger 11 53 rne (natToInt 1)))"); + +// fpCast +// {{ fpCast (2.5 : Float32) == (2.5 : Float64) }} +prove_it (parse_core "EqTrue (fpIeeeEq 11 53 (fpCast 8 24 11 53 rne (fpFromRational 8 24 rne (ratio (natToInt 5) (natToInt 2)))) (fpFromRational 11 53 rne (ratio (natToInt 5) (natToInt 2))))"); + +// fpRound +// {{ fpRound (2.5 : Float64) == 2 }} +// prove_it (parse_core "EqTrue (fpIeeeEq 11 53 (fpRound 11 53 rne (fpFromRational 11 53 rne (ratio (natToInt 5) (natToInt 2)))) (fpFromInteger 11 53 rne (natToInt 2)))"); + +// fpFromBV +// {{ fpFromBV rne (-1 : [64]) == (18446744073709551616 : Float64) }} +prove_it (parse_core "EqTrue (fpIeeeEq 11 53 (fpFromBV 63 11 53 rne (intToBv 64 (intNeg (natToInt 1)))) (fpFromInteger 11 53 rne (natToInt 18446744073709551616)))"); + +// fpFromSBV +// {{ fpFromSBV rne (-1 : [64]) == (-1 : Float64) }} +prove_it (parse_core "EqTrue (fpIeeeEq 11 53 (fpFromSBV 63 11 53 rne (intToBv 64 (intNeg (natToInt 1)))) (fpFromInteger 11 53 rne (intNeg (natToInt 1))))"); diff --git a/intTests/test1237_unit_tests/test.sh b/intTests/test1237_unit_tests/test.sh new file mode 100644 index 0000000000..2315cc233c --- /dev/null +++ b/intTests/test1237_unit_tests/test.sh @@ -0,0 +1,3 @@ +set -e + +$SAW test.saw diff --git a/otherTests/saw-core-rocq/test_cryptol_primitives_1.v.good b/otherTests/saw-core-rocq/test_cryptol_primitives_1.v.good index 5b0baa1b33..0b95e0a7b6 100644 --- a/otherTests/saw-core-rocq/test_cryptol_primitives_1.v.good +++ b/otherTests/saw-core-rocq/test_cryptol_primitives_1.v.good @@ -10,6 +10,7 @@ From CryptolToRocq Require Import SAWCoreVectorsAsRocqVectors. Import VectorNotations. (** Post-preamble section specified by you *) +From Flocq Require IEEE754.BinarySingleNaN. From CryptolToRocq Require Import SAWCorePrelude. From CryptolToRocq Require Import SAWCorePreludeExtra. @@ -1312,6 +1313,16 @@ Definition PEqRational: PEq SAWCoreScaffolding.Rational := Init.Datatypes.bool) SAWCoreScaffolding.RecordTypeNil SAWCoreScaffolding.rationalEqb SAWCoreScaffolding.RecordNil. +Definition PEqFloat: forall (e p: Init.Datatypes.nat), + PEq (SAWCoreScaffolding.Float e p) := + fun (e p: Init.Datatypes.nat) + => + @SAWCoreScaffolding.RecordCons "eq"%string (forall (_1 _2: + SAWCoreScaffolding.Float e p), + Init.Datatypes.bool) SAWCoreScaffolding.RecordTypeNil + (SAWCoreScaffolding.fpIeeeEq e p) SAWCoreScaffolding.RecordNil + . + Definition PEqIntMod: forall (n: Init.Datatypes.nat), PEq (SAWCoreScaffolding.IntMod n) := fun (n: Init.Datatypes.nat) @@ -1592,6 +1603,45 @@ Definition PCmpRational: PCmp SAWCoreScaffolding.Rational := Init.Datatypes.bool) SAWCoreScaffolding.RecordTypeNil SAWCoreScaffolding.rationalLt SAWCoreScaffolding.RecordNil))). +Definition PCmpFloat: forall (e p: Init.Datatypes.nat), + PCmp (SAWCoreScaffolding.Float e p) := + fun (e p: Init.Datatypes.nat) + => + @SAWCoreScaffolding.RecordCons "cmpEq"%string + (PEq (SAWCoreScaffolding.Float e p)) + (SAWCoreScaffolding.RecordTypeCons "cmp"%string (forall (_1 _2: + SAWCoreScaffolding.Float e p) (_3: Init.Datatypes.bool), + Init.Datatypes.bool) + (SAWCoreScaffolding.RecordTypeCons "le"%string (forall (_1 _2: + SAWCoreScaffolding.Float e p), + Init.Datatypes.bool) + (SAWCoreScaffolding.RecordTypeCons "lt"%string (forall (_1 _2: + SAWCoreScaffolding.Float e p), + Init.Datatypes.bool) SAWCoreScaffolding.RecordTypeNil))) + (PEqFloat e p) + (@SAWCoreScaffolding.RecordCons "cmp"%string (forall (_1 _2: + SAWCoreScaffolding.Float e p) (_3: Init.Datatypes.bool), + Init.Datatypes.bool) + (SAWCoreScaffolding.RecordTypeCons "le"%string (forall (_1 _2: + SAWCoreScaffolding.Float e p), + Init.Datatypes.bool) + (SAWCoreScaffolding.RecordTypeCons "lt"%string (forall (_1 _2: + SAWCoreScaffolding.Float e p), + Init.Datatypes.bool) SAWCoreScaffolding.RecordTypeNil)) + (SAWCorePrelude.fpCmp e p) + (@SAWCoreScaffolding.RecordCons "le"%string (forall (_1 _2: + SAWCoreScaffolding.Float e p), + Init.Datatypes.bool) + (SAWCoreScaffolding.RecordTypeCons "lt"%string (forall (_1 _2: + SAWCoreScaffolding.Float e p), + Init.Datatypes.bool) SAWCoreScaffolding.RecordTypeNil) + (SAWCorePrelude.fpLe e p) + (@SAWCoreScaffolding.RecordCons "lt"%string (forall (_1 _2: + SAWCoreScaffolding.Float e p), + Init.Datatypes.bool) SAWCoreScaffolding.RecordTypeNil + (SAWCoreScaffolding.fpLt e p) SAWCoreScaffolding.RecordNil))) + . + Definition PCmpVec: forall (n: Init.Datatypes.nat) (a: Type) {Inh_a: SAWCoreScaffolding.Inhabited a} (_1: PCmp a), PCmp (SAWCoreVectorsAsRocqVectors.Vec n a) := @@ -3456,6 +3506,13 @@ Definition PZeroIntMod: forall (n: Init.Datatypes.nat), Definition PZeroRational: PZero SAWCoreScaffolding.Rational := SAWCorePrelude.rationalZero. +Definition PZeroFloat: forall (e p: Init.Datatypes.nat), + PZero (SAWCoreScaffolding.Float e p) := + fun (e p: Init.Datatypes.nat) + => + SAWCoreScaffolding.fpPosZero e p + . + Definition PZeroIntModNum: forall (num: Num), PZero (IntModNum num) := fun (num: Num) => @@ -5307,6 +5364,86 @@ Definition PRingRational: PRing SAWCoreScaffolding.Rational := SAWCorePrelude.integerToRational SAWCoreScaffolding.RecordNil))))). +Definition PRingFloat: forall (e p: Init.Datatypes.nat), + PRing (SAWCoreScaffolding.Float e p) := + fun (e p: Init.Datatypes.nat) + => + @SAWCoreScaffolding.RecordCons "ringZero"%string + (PZero (SAWCoreScaffolding.Float e p)) + (SAWCoreScaffolding.RecordTypeCons "add"%string (forall (_1 _2: + SAWCoreScaffolding.Float e p), + SAWCoreScaffolding.Float e p) + (SAWCoreScaffolding.RecordTypeCons "sub"%string (forall (_1 _2: + SAWCoreScaffolding.Float e p), + SAWCoreScaffolding.Float e p) + (SAWCoreScaffolding.RecordTypeCons "mul"%string (forall (_1 _2: + SAWCoreScaffolding.Float e p), + SAWCoreScaffolding.Float e p) + (SAWCoreScaffolding.RecordTypeCons "neg"%string (forall (_1: + SAWCoreScaffolding.Float e p), + SAWCoreScaffolding.Float e p) + (SAWCoreScaffolding.RecordTypeCons "int"%string (forall + (_1: SAWCoreScaffolding.Integer), + SAWCoreScaffolding.Float e p) + SAWCoreScaffolding.RecordTypeNil))))) (PZeroFloat e p) + (@SAWCoreScaffolding.RecordCons "add"%string (forall (_1 _2: + SAWCoreScaffolding.Float e p), + SAWCoreScaffolding.Float e p) + (SAWCoreScaffolding.RecordTypeCons "sub"%string (forall (_1 _2: + SAWCoreScaffolding.Float e p), + SAWCoreScaffolding.Float e p) + (SAWCoreScaffolding.RecordTypeCons "mul"%string (forall (_1 _2: + SAWCoreScaffolding.Float e p), + SAWCoreScaffolding.Float e p) + (SAWCoreScaffolding.RecordTypeCons "neg"%string (forall (_1: + SAWCoreScaffolding.Float e p), + SAWCoreScaffolding.Float e p) + (SAWCoreScaffolding.RecordTypeCons "int"%string (forall + (_1: SAWCoreScaffolding.Integer), + SAWCoreScaffolding.Float e p) + SAWCoreScaffolding.RecordTypeNil)))) + (SAWCoreVectorsAsRocqVectors.fpAdd e p SAWCorePrelude.rne) + (@SAWCoreScaffolding.RecordCons "sub"%string (forall (_1 _2: + SAWCoreScaffolding.Float e p), + SAWCoreScaffolding.Float e p) + (SAWCoreScaffolding.RecordTypeCons "mul"%string (forall (_1 _2: + SAWCoreScaffolding.Float e p), + SAWCoreScaffolding.Float e p) + (SAWCoreScaffolding.RecordTypeCons "neg"%string (forall (_1: + SAWCoreScaffolding.Float e p), + SAWCoreScaffolding.Float e p) + (SAWCoreScaffolding.RecordTypeCons "int"%string (forall + (_1: SAWCoreScaffolding.Integer), + SAWCoreScaffolding.Float e p) + SAWCoreScaffolding.RecordTypeNil))) + (SAWCoreVectorsAsRocqVectors.fpSub e p SAWCorePrelude.rne) + (@SAWCoreScaffolding.RecordCons "mul"%string (forall (_1 _2: + SAWCoreScaffolding.Float e p), + SAWCoreScaffolding.Float e p) + (SAWCoreScaffolding.RecordTypeCons "neg"%string (forall (_1: + SAWCoreScaffolding.Float e p), + SAWCoreScaffolding.Float e p) + (SAWCoreScaffolding.RecordTypeCons "int"%string (forall + (_1: SAWCoreScaffolding.Integer), + SAWCoreScaffolding.Float e p) + SAWCoreScaffolding.RecordTypeNil)) + (SAWCoreVectorsAsRocqVectors.fpMul e p SAWCorePrelude.rne) + (@SAWCoreScaffolding.RecordCons "neg"%string (forall (_1: + SAWCoreScaffolding.Float e p), + SAWCoreScaffolding.Float e p) + (SAWCoreScaffolding.RecordTypeCons "int"%string (forall + (_1: SAWCoreScaffolding.Integer), + SAWCoreScaffolding.Float e p) + SAWCoreScaffolding.RecordTypeNil) + (SAWCoreScaffolding.fpNeg e p) + (@SAWCoreScaffolding.RecordCons "int"%string (forall + (_1: SAWCoreScaffolding.Integer), + SAWCoreScaffolding.Float e p) + SAWCoreScaffolding.RecordTypeNil + (SAWCoreVectorsAsRocqVectors.fpFromInteger e p + SAWCorePrelude.rne) SAWCoreScaffolding.RecordNil))))) + . + Definition PRingVec: forall (n: Init.Datatypes.nat) (a: Type) {Inh_a: SAWCoreScaffolding.Inhabited a} (_1: PRing a), PRing (SAWCoreVectorsAsRocqVectors.Vec n a) := @@ -7979,6 +8116,38 @@ Definition PFieldRational: PField SAWCoreScaffolding.Rational := SAWCoreScaffolding.Rational) SAWCoreScaffolding.RecordTypeNil SAWCorePrelude.rationalDiv SAWCoreScaffolding.RecordNil)). +Definition PFieldFloat: forall (e p: Init.Datatypes.nat), + PField (SAWCoreScaffolding.Float e p) := + fun (e p: Init.Datatypes.nat) + => + @SAWCoreScaffolding.RecordCons "fieldRing"%string + (PRing (SAWCoreScaffolding.Float e p)) + (SAWCoreScaffolding.RecordTypeCons "recip"%string (forall (_1: + SAWCoreScaffolding.Float e p), + SAWCoreScaffolding.Float e p) + (SAWCoreScaffolding.RecordTypeCons "fieldDiv"%string (forall + (_1 _2: SAWCoreScaffolding.Float e p), + SAWCoreScaffolding.Float e p) + SAWCoreScaffolding.RecordTypeNil)) (PRingFloat e p) + (@SAWCoreScaffolding.RecordCons "recip"%string (forall (_1: + SAWCoreScaffolding.Float e p), + SAWCoreScaffolding.Float e p) + (SAWCoreScaffolding.RecordTypeCons "fieldDiv"%string (forall + (_1 _2: SAWCoreScaffolding.Float e p), + SAWCoreScaffolding.Float e p) + SAWCoreScaffolding.RecordTypeNil) + (SAWCoreVectorsAsRocqVectors.fpDiv e p SAWCorePrelude.rne + (SAWCoreVectorsAsRocqVectors.fpFromInteger e p SAWCorePrelude.rne + (SAWCoreScaffolding.natToInt + (Stdlib.PArith.BinPos.Pos.to_nat Stdlib.PArith.BinPos.xH)))) + (@SAWCoreScaffolding.RecordCons "fieldDiv"%string (forall (_1 _2: + SAWCoreScaffolding.Float e p), + SAWCoreScaffolding.Float e p) + SAWCoreScaffolding.RecordTypeNil + (SAWCoreVectorsAsRocqVectors.fpDiv e p SAWCorePrelude.rne) + SAWCoreScaffolding.RecordNil)) + . + Definition PFieldIntMod: forall (n: Init.Datatypes.nat), PField (SAWCoreScaffolding.IntMod n) := fun (n: Init.Datatypes.nat) @@ -8137,6 +8306,111 @@ Definition PRoundRational: PRound SAWCoreScaffolding.Rational := SAWCorePrelude.rationalRoundToEven SAWCoreScaffolding.RecordNil)))))). +Definition PRoundFloat: forall (e p: Init.Datatypes.nat), + PRound (SAWCoreScaffolding.Float e p) := + fun (e p: Init.Datatypes.nat) + => + @SAWCoreScaffolding.RecordCons "roundField"%string + (PField (SAWCoreScaffolding.Float e p)) + (SAWCoreScaffolding.RecordTypeCons "roundCmp"%string + (PCmp (SAWCoreScaffolding.Float e p)) + (SAWCoreScaffolding.RecordTypeCons "floor"%string (forall (_1: + SAWCoreScaffolding.Float e p), + SAWCoreScaffolding.Integer) + (SAWCoreScaffolding.RecordTypeCons "ceiling"%string (forall (_1: + SAWCoreScaffolding.Float e p), + SAWCoreScaffolding.Integer) + (SAWCoreScaffolding.RecordTypeCons "trunc"%string (forall + (_1: SAWCoreScaffolding.Float e p), + SAWCoreScaffolding.Integer) + (SAWCoreScaffolding.RecordTypeCons "roundAway"%string + (forall (_1: SAWCoreScaffolding.Float e p), + SAWCoreScaffolding.Integer) + (SAWCoreScaffolding.RecordTypeCons "roundToEven"%string + (forall (_1: SAWCoreScaffolding.Float e p), + SAWCoreScaffolding.Integer) + SAWCoreScaffolding.RecordTypeNil)))))) + (PFieldFloat e p) + (@SAWCoreScaffolding.RecordCons "roundCmp"%string + (PCmp (SAWCoreScaffolding.Float e p)) + (SAWCoreScaffolding.RecordTypeCons "floor"%string (forall (_1: + SAWCoreScaffolding.Float e p), + SAWCoreScaffolding.Integer) + (SAWCoreScaffolding.RecordTypeCons "ceiling"%string (forall (_1: + SAWCoreScaffolding.Float e p), + SAWCoreScaffolding.Integer) + (SAWCoreScaffolding.RecordTypeCons "trunc"%string (forall + (_1: SAWCoreScaffolding.Float e p), + SAWCoreScaffolding.Integer) + (SAWCoreScaffolding.RecordTypeCons "roundAway"%string + (forall (_1: SAWCoreScaffolding.Float e p), + SAWCoreScaffolding.Integer) + (SAWCoreScaffolding.RecordTypeCons "roundToEven"%string + (forall (_1: SAWCoreScaffolding.Float e p), + SAWCoreScaffolding.Integer) + SAWCoreScaffolding.RecordTypeNil))))) (PCmpFloat e p) + (@SAWCoreScaffolding.RecordCons "floor"%string (forall (_1: + SAWCoreScaffolding.Float e p), + SAWCoreScaffolding.Integer) + (SAWCoreScaffolding.RecordTypeCons "ceiling"%string (forall (_1: + SAWCoreScaffolding.Float e p), + SAWCoreScaffolding.Integer) + (SAWCoreScaffolding.RecordTypeCons "trunc"%string (forall + (_1: SAWCoreScaffolding.Float e p), + SAWCoreScaffolding.Integer) + (SAWCoreScaffolding.RecordTypeCons "roundAway"%string + (forall (_1: SAWCoreScaffolding.Float e p), + SAWCoreScaffolding.Integer) + (SAWCoreScaffolding.RecordTypeCons "roundToEven"%string + (forall (_1: SAWCoreScaffolding.Float e p), + SAWCoreScaffolding.Integer) + SAWCoreScaffolding.RecordTypeNil)))) + (SAWCoreVectorsAsRocqVectors.fpToInteger e p SAWCorePrelude.rtn) + (@SAWCoreScaffolding.RecordCons "ceiling"%string (forall (_1: + SAWCoreScaffolding.Float e p), + SAWCoreScaffolding.Integer) + (SAWCoreScaffolding.RecordTypeCons "trunc"%string (forall + (_1: SAWCoreScaffolding.Float e p), + SAWCoreScaffolding.Integer) + (SAWCoreScaffolding.RecordTypeCons "roundAway"%string + (forall (_1: SAWCoreScaffolding.Float e p), + SAWCoreScaffolding.Integer) + (SAWCoreScaffolding.RecordTypeCons "roundToEven"%string + (forall (_1: SAWCoreScaffolding.Float e p), + SAWCoreScaffolding.Integer) + SAWCoreScaffolding.RecordTypeNil))) + (SAWCoreVectorsAsRocqVectors.fpToInteger e p + SAWCorePrelude.rtp) + (@SAWCoreScaffolding.RecordCons "trunc"%string (forall (_1: + SAWCoreScaffolding.Float e p), + SAWCoreScaffolding.Integer) + (SAWCoreScaffolding.RecordTypeCons "roundAway"%string + (forall (_1: SAWCoreScaffolding.Float e p), + SAWCoreScaffolding.Integer) + (SAWCoreScaffolding.RecordTypeCons "roundToEven"%string + (forall (_1: SAWCoreScaffolding.Float e p), + SAWCoreScaffolding.Integer) + SAWCoreScaffolding.RecordTypeNil)) + (SAWCoreVectorsAsRocqVectors.fpToInteger e p + SAWCorePrelude.rtz) + (@SAWCoreScaffolding.RecordCons "roundAway"%string (forall + (_1: SAWCoreScaffolding.Float e p), + SAWCoreScaffolding.Integer) + (SAWCoreScaffolding.RecordTypeCons "roundToEven"%string + (forall (_1: SAWCoreScaffolding.Float e p), + SAWCoreScaffolding.Integer) + SAWCoreScaffolding.RecordTypeNil) + (SAWCoreVectorsAsRocqVectors.fpToInteger e p + SAWCorePrelude.rna) + (@SAWCoreScaffolding.RecordCons "roundToEven"%string + (forall (_1: SAWCoreScaffolding.Float e p), + SAWCoreScaffolding.Integer) + SAWCoreScaffolding.RecordTypeNil + (SAWCoreVectorsAsRocqVectors.fpToInteger e p + SAWCorePrelude.rne) + SAWCoreScaffolding.RecordNil)))))) + . + Definition PLiteral: forall (a: Type), Type := fun (a: Type) => @@ -8192,6 +8466,14 @@ Definition PLiteralRational: PLiteral SAWCoreScaffolding.Rational := SAWCorePrelude.integerToRational (SAWCoreScaffolding.natToInt x) . +Definition PLiteralFloat: forall (e p: Init.Datatypes.nat), + PLiteral (SAWCoreScaffolding.Float e p) := + fun (e p x: Init.Datatypes.nat) + => + SAWCoreVectorsAsRocqVectors.fpFromInteger e p SAWCorePrelude.rne + (SAWCoreScaffolding.natToInt x) + . + Definition PFLiteral: forall (a: Type), Type := fun (a: Type) => @@ -8206,6 +8488,15 @@ Definition PFLiteralRational: PFLiteral SAWCoreScaffolding.Rational := (SAWCoreScaffolding.natToInt n) . +Definition PFLiteralFloat: forall (e p: Init.Datatypes.nat), + PFLiteral (SAWCoreScaffolding.Float e p) := + fun (e p m n r: Init.Datatypes.nat) + => + SAWCoreVectorsAsRocqVectors.fpFromRational e p SAWCorePrelude.rne + (SAWCoreScaffolding.ratio (SAWCoreScaffolding.natToInt m) + (SAWCoreScaffolding.natToInt n)) + . + Definition ecNumber: forall (val: Num) (a: Type) (_1: PLiteral a), a := fun (val: Num) (a: Type) (pa: PLiteral a) => @@ -10646,513 +10937,259 @@ Definition ecScanl: forall (n: Num) (a b: Type) (_1: forall (_1: a) (_2: b), a) ) n . -Definition TCFloat: forall (_1 _2: Num), Type := - fun (_1 _2: Num) - => - SAWCoreScaffolding.UnitType - . - -Definition PEqFloat: forall (e p: Num), PEq (TCFloat e p) := +Definition FloatNum: forall (_1 _2: Num), Type := fun (e p: Num) => - @SAWCoreScaffolding.RecordCons "eq"%string (forall (x y: TCFloat e p), - Init.Datatypes.bool) SAWCoreScaffolding.RecordTypeNil (fun (x y: - TCFloat e p) + @CryptolPrimitivesForSAWCore.Num_rect (fun (_1: Num) => Type) (fun + (e1: Init.Datatypes.nat) => - SAWCoreScaffolding.error Init.Datatypes.bool - "Unimplemented: (==) Float"%string - ) SAWCoreScaffolding.RecordNil - . - -Definition PCmpFloat: forall (e p: Num), PCmp (TCFloat e p) := - fun (e p: Num) - => - let var__0 - := - TCFloat e p - in - @SAWCoreScaffolding.RecordCons "cmpEq"%string (PEq var__0) - (SAWCoreScaffolding.RecordTypeCons "cmp"%string (forall (x y: var__0) - (k: Init.Datatypes.bool), - Init.Datatypes.bool) - (SAWCoreScaffolding.RecordTypeCons "le"%string (forall - (x y: var__0), - Init.Datatypes.bool) - (SAWCoreScaffolding.RecordTypeCons "lt"%string (forall - (x y: var__0), - Init.Datatypes.bool) SAWCoreScaffolding.RecordTypeNil))) - (PEqFloat e p) - (@SAWCoreScaffolding.RecordCons "cmp"%string (forall (x y: var__0) - (k: Init.Datatypes.bool), - Init.Datatypes.bool) - (SAWCoreScaffolding.RecordTypeCons "le"%string (forall - (x y: var__0), - Init.Datatypes.bool) - (SAWCoreScaffolding.RecordTypeCons "lt"%string (forall - (x y: var__0), - Init.Datatypes.bool) SAWCoreScaffolding.RecordTypeNil)) - (fun (x y: var__0) (k: Init.Datatypes.bool) - => - SAWCoreScaffolding.error Init.Datatypes.bool - "Unimplemented: Cmp Float"%string - ) (@SAWCoreScaffolding.RecordCons "le"%string (forall (x y: var__0), - Init.Datatypes.bool) - (SAWCoreScaffolding.RecordTypeCons "lt"%string (forall - (x y: var__0), - Init.Datatypes.bool) SAWCoreScaffolding.RecordTypeNil) - (fun (x y: var__0) - => - SAWCoreScaffolding.error Init.Datatypes.bool - "Unimplemented: Cmp Float"%string - ) (@SAWCoreScaffolding.RecordCons "lt"%string (forall - (x y: var__0), - Init.Datatypes.bool) SAWCoreScaffolding.RecordTypeNil - (fun (x y: var__0) - => - SAWCoreScaffolding.error Init.Datatypes.bool - "Unimplemented: Cmp Float"%string - ) SAWCoreScaffolding.RecordNil))) - . - -Definition PZeroFloat: forall (e p: Num), PZero (TCFloat e p) := - fun (e p: Num) - => - SAWCoreScaffolding.error (TCFloat e p) "Unimplemented: Zero Float"%string + @CryptolPrimitivesForSAWCore.Num_rect (fun (_1: Num) => Type) + (SAWCoreScaffolding.Float e1) + (SAWCoreScaffolding.Float e1 SAWCoreScaffolding.Zero) p + ) (SAWCoreScaffolding.Float SAWCoreScaffolding.Zero + SAWCoreScaffolding.Zero) e . -Definition PRingFloat: forall (e p: Num), PRing (TCFloat e p) := +Definition FloatNumInhabited: forall (e p: Num), FloatNum e p := fun (e p: Num) => - let var__0 - := - TCFloat e p - in - @SAWCoreScaffolding.RecordCons "ringZero"%string (PZero var__0) - (SAWCoreScaffolding.RecordTypeCons "add"%string (forall (x y: var__0), - var__0) - (SAWCoreScaffolding.RecordTypeCons "sub"%string (forall - (x y: var__0), - var__0) - (SAWCoreScaffolding.RecordTypeCons "mul"%string (forall - (x y: var__0), - var__0) - (SAWCoreScaffolding.RecordTypeCons "neg"%string (forall - (x: var__0), - var__0) - (SAWCoreScaffolding.RecordTypeCons "int"%string (forall - (i: SAWCoreScaffolding.Integer), - var__0) SAWCoreScaffolding.RecordTypeNil))))) - (PZeroFloat e p) - (@SAWCoreScaffolding.RecordCons "add"%string (forall (x y: var__0), - var__0) - (SAWCoreScaffolding.RecordTypeCons "sub"%string (forall - (x y: var__0), - var__0) - (SAWCoreScaffolding.RecordTypeCons "mul"%string (forall - (x y: var__0), - var__0) - (SAWCoreScaffolding.RecordTypeCons "neg"%string (forall - (x: var__0), - var__0) - (SAWCoreScaffolding.RecordTypeCons "int"%string (forall - (i: SAWCoreScaffolding.Integer), - var__0) SAWCoreScaffolding.RecordTypeNil)))) (fun - (x y: var__0) + @CryptolPrimitivesForSAWCore.Num_rect (fun (e1: Num) => FloatNum e1 p) + (fun (e1: Init.Datatypes.nat) + => + @CryptolPrimitivesForSAWCore.Num_rect (FloatNum (TCNum e1)) + (SAWCoreScaffolding.fpPosZero e1) + (SAWCoreScaffolding.fpPosZero e1 SAWCoreScaffolding.Zero) p + ) (SAWCoreScaffolding.fpPosZero SAWCoreScaffolding.Zero + SAWCoreScaffolding.Zero) e + . + +#[global] Instance Inhabited_FloatNum (e p : Num) : Inhabited (FloatNum e p) := MkInhabited (FloatNum e p) (FloatNumInhabited e p). +Definition FloatNum_cong: forall (e e' p p': Num) (_1: @Init.Logic.eq Num e e') + (_2: @Init.Logic.eq Num p p'), + @Init.Logic.eq Type (FloatNum e p) (FloatNum e' p') := + fun (e e' p p': Num) (eq_e: @Init.Logic.eq Num e e') (eq_p: + @Init.Logic.eq Num p p') + => + SAWCorePrelude.trans Type (FloatNum e p) (FloatNum e' p) (FloatNum e' p') + (SAWCorePrelude.eq_cong Num e e' eq_e Type (fun (x: Num) => - SAWCoreScaffolding.error var__0 "Unimplemented: (+) Float"%string - ) (@SAWCoreScaffolding.RecordCons "sub"%string (forall - (x y: var__0), - var__0) - (SAWCoreScaffolding.RecordTypeCons "mul"%string (forall - (x y: var__0), - var__0) - (SAWCoreScaffolding.RecordTypeCons "neg"%string (forall - (x: var__0), - var__0) - (SAWCoreScaffolding.RecordTypeCons "int"%string (forall - (i: SAWCoreScaffolding.Integer), - var__0) SAWCoreScaffolding.RecordTypeNil))) (fun - (x y: var__0) - => - SAWCoreScaffolding.error var__0 - "Unimplemented: (-) Float"%string - ) (@SAWCoreScaffolding.RecordCons "mul"%string (forall - (x y: var__0), - var__0) - (SAWCoreScaffolding.RecordTypeCons "neg"%string (forall - (x: var__0), - var__0) - (SAWCoreScaffolding.RecordTypeCons "int"%string (forall - (i: SAWCoreScaffolding.Integer), - var__0) SAWCoreScaffolding.RecordTypeNil)) (fun - (x y: var__0) - => - SAWCoreScaffolding.error var__0 - "Unimplemented: (*) Float"%string - ) (@SAWCoreScaffolding.RecordCons "neg"%string (forall - (x: var__0), - var__0) - (SAWCoreScaffolding.RecordTypeCons "int"%string (forall - (i: SAWCoreScaffolding.Integer), - var__0) SAWCoreScaffolding.RecordTypeNil) (fun - (x: var__0) - => - SAWCoreScaffolding.error var__0 - "Unimplemented: neg Float"%string - ) (@SAWCoreScaffolding.RecordCons "int"%string (forall - (i: SAWCoreScaffolding.Integer), - var__0) SAWCoreScaffolding.RecordTypeNil (fun - (i: SAWCoreScaffolding.Integer) - => - SAWCoreScaffolding.error var__0 - "Unimplemented: toInteger Float"%string - ) SAWCoreScaffolding.RecordNil))))) - . - -Definition PFieldFloat: forall (e p: Num), PField (TCFloat e p) := - fun (e p: Num) - => - let var__0 - := - TCFloat e p - in - @SAWCoreScaffolding.RecordCons "fieldRing"%string (PRing var__0) - (SAWCoreScaffolding.RecordTypeCons "recip"%string (forall (x: var__0), - var__0) - (SAWCoreScaffolding.RecordTypeCons "fieldDiv"%string (forall - (x y: var__0), - var__0) SAWCoreScaffolding.RecordTypeNil)) (PRingFloat e p) - (@SAWCoreScaffolding.RecordCons "recip"%string (forall (x: var__0), - var__0) - (SAWCoreScaffolding.RecordTypeCons "fieldDiv"%string (forall - (x y: var__0), - var__0) SAWCoreScaffolding.RecordTypeNil) (fun (x: var__0) + FloatNum x p + )) + (SAWCorePrelude.eq_cong Num p p' eq_p Type (fun (x: Num) => - SAWCoreScaffolding.error var__0 - "Unimplemented: recip Float"%string - ) (@SAWCoreScaffolding.RecordCons "fieldDiv"%string (forall - (x y: var__0), - var__0) SAWCoreScaffolding.RecordTypeNil (fun (x y: var__0) - => - SAWCoreScaffolding.error var__0 - "Unimplemented: (/.) Float"%string - ) SAWCoreScaffolding.RecordNil)) + FloatNum e' x + )) . -Definition PRoundFloat: forall (e p: Num), - PRound (TCFloat e p) := - fun (e p: Num) +Definition floatNumFunction: forall (motive: forall (_1 _2: Num), Type) + {Inh_motive: forall (_1 _2: Num), + SAWCoreScaffolding.Inhabited (motive _1 _2)} (_1: forall + (e p: Init.Datatypes.nat), + motive (TCNum e) (TCNum p)) (e p: Num), + motive e p := + fun (motive: forall (_1 _2: Num), Type) (Inh_motive: forall (_1 _2: Num), + SAWCoreScaffolding.Inhabited (motive _1 _2)) (f: forall + (e p: Init.Datatypes.nat), + motive (TCNum e) (TCNum p)) (e p: Num) => - let var__0 - := - TCFloat e p - in - @SAWCoreScaffolding.RecordCons "roundField"%string (PField var__0) - (SAWCoreScaffolding.RecordTypeCons "roundCmp"%string (PCmp var__0) - (SAWCoreScaffolding.RecordTypeCons "floor"%string (forall - (x: var__0), - SAWCoreScaffolding.Integer) - (SAWCoreScaffolding.RecordTypeCons "ceiling"%string (forall - (x: var__0), - SAWCoreScaffolding.Integer) - (SAWCoreScaffolding.RecordTypeCons "trunc"%string (forall - (x: var__0), - SAWCoreScaffolding.Integer) - (SAWCoreScaffolding.RecordTypeCons "roundAway"%string - (forall (x: var__0), SAWCoreScaffolding.Integer) - (SAWCoreScaffolding.RecordTypeCons "roundToEven"%string - (forall (x: var__0), SAWCoreScaffolding.Integer) - SAWCoreScaffolding.RecordTypeNil)))))) - (PFieldFloat e p) - (@SAWCoreScaffolding.RecordCons "roundCmp"%string (PCmp var__0) - (SAWCoreScaffolding.RecordTypeCons "floor"%string (forall - (x: var__0), - SAWCoreScaffolding.Integer) - (SAWCoreScaffolding.RecordTypeCons "ceiling"%string (forall - (x: var__0), - SAWCoreScaffolding.Integer) - (SAWCoreScaffolding.RecordTypeCons "trunc"%string (forall - (x: var__0), - SAWCoreScaffolding.Integer) - (SAWCoreScaffolding.RecordTypeCons "roundAway"%string - (forall (x: var__0), SAWCoreScaffolding.Integer) - (SAWCoreScaffolding.RecordTypeCons "roundToEven"%string - (forall (x: var__0), SAWCoreScaffolding.Integer) - SAWCoreScaffolding.RecordTypeNil))))) (PCmpFloat e p) - (@SAWCoreScaffolding.RecordCons "floor"%string (forall (x: var__0), - SAWCoreScaffolding.Integer) - (SAWCoreScaffolding.RecordTypeCons "ceiling"%string (forall - (x: var__0), - SAWCoreScaffolding.Integer) - (SAWCoreScaffolding.RecordTypeCons "trunc"%string (forall - (x: var__0), - SAWCoreScaffolding.Integer) - (SAWCoreScaffolding.RecordTypeCons "roundAway"%string - (forall (x: var__0), SAWCoreScaffolding.Integer) - (SAWCoreScaffolding.RecordTypeCons "roundToEven"%string - (forall (x: var__0), SAWCoreScaffolding.Integer) - SAWCoreScaffolding.RecordTypeNil)))) (fun (x: var__0) + @CryptolPrimitivesForSAWCore.Num_rect (fun (e1: Num) => motive e1 p) (fun + (e1: Init.Datatypes.nat) + => + @CryptolPrimitivesForSAWCore.Num_rect (fun (p1: Num) => - SAWCoreScaffolding.error SAWCoreScaffolding.Integer - "Unimplemented: floor Float"%string - ) - (@SAWCoreScaffolding.RecordCons "ceiling"%string (forall - (x: var__0), - SAWCoreScaffolding.Integer) - (SAWCoreScaffolding.RecordTypeCons "trunc"%string (forall - (x: var__0), - SAWCoreScaffolding.Integer) - (SAWCoreScaffolding.RecordTypeCons "roundAway"%string - (forall (x: var__0), SAWCoreScaffolding.Integer) - (SAWCoreScaffolding.RecordTypeCons "roundToEven"%string - (forall (x: var__0), SAWCoreScaffolding.Integer) - SAWCoreScaffolding.RecordTypeNil))) (fun (x: var__0) - => - SAWCoreScaffolding.error SAWCoreScaffolding.Integer - "Unimplemented: ceiling Float"%string - ) - (@SAWCoreScaffolding.RecordCons "trunc"%string (forall - (x: var__0), - SAWCoreScaffolding.Integer) - (SAWCoreScaffolding.RecordTypeCons "roundAway"%string - (forall (x: var__0), SAWCoreScaffolding.Integer) - (SAWCoreScaffolding.RecordTypeCons "roundToEven"%string - (forall (x: var__0), SAWCoreScaffolding.Integer) - SAWCoreScaffolding.RecordTypeNil)) (fun (x: var__0) - => - SAWCoreScaffolding.error SAWCoreScaffolding.Integer - "Unimplemented: trunc Float"%string - ) - (@SAWCoreScaffolding.RecordCons "roundAway"%string (forall - (x: var__0), - SAWCoreScaffolding.Integer) - (SAWCoreScaffolding.RecordTypeCons "roundToEven"%string - (forall (x: var__0), SAWCoreScaffolding.Integer) - SAWCoreScaffolding.RecordTypeNil) (fun (x: var__0) - => - SAWCoreScaffolding.error SAWCoreScaffolding.Integer - "Unimplemented: roundAway Float"%string - ) - (@SAWCoreScaffolding.RecordCons "roundToEven"%string - (forall (x: var__0), SAWCoreScaffolding.Integer) - SAWCoreScaffolding.RecordTypeNil (fun (x: var__0) - => - SAWCoreScaffolding.error SAWCoreScaffolding.Integer - "Unimplemented: roundToEven Float"%string - ) SAWCoreScaffolding.RecordNil)))))) + motive (TCNum e1) p1 + ) (f e1) + (SAWCoreScaffolding.error (motive (TCNum e1) TCInf) + "p should not be infinite"%string) p + ) (SAWCoreScaffolding.error (motive TCInf p) + "e should not be infinite"%string) e . -Definition PLiteralFloat: forall (e p: Num), PLiteral (TCFloat e p) := - fun (e p: Num) (x: Init.Datatypes.nat) - => - SAWCoreScaffolding.error (TCFloat e p) - "Unimplemented: Literal Float"%string - . +Definition ecFpNaN: forall (e p: Num), FloatNum e p := + floatNumFunction FloatNum SAWCoreScaffolding.fpNaN. -Definition PFLiteralFloat: forall (e p: Num), PFLiteral (TCFloat e p) := - fun (e p: Num) (m n r: Init.Datatypes.nat) - => - SAWCoreScaffolding.Unit - . - -Definition ecFpNaN: forall (e p: Num), TCFloat e p := - fun (e p: Num) - => - SAWCoreScaffolding.error (TCFloat e p) "Unimplemented: fpNaN"%string - . - -Definition ecFpPosInf: forall (e p: Num), TCFloat e p := - fun (e p: Num) - => - SAWCoreScaffolding.error (TCFloat e p) "Unimplemented: fpPosInf"%string - . +Definition ecFpPosInf: forall (e p: Num), FloatNum e p := + floatNumFunction FloatNum SAWCoreScaffolding.fpPosInf. Definition ecFpFromBits: forall (e p: Num) (_1: seq (tcAdd e p) Init.Datatypes.bool), - TCFloat e p := - fun (e p: Num) (_1: seq (tcAdd e p) Init.Datatypes.bool) - => - SAWCoreScaffolding.error (TCFloat e p) "Unimplemented: fpFromBits"%string - . + FloatNum e p := + floatNumFunction (fun (e p: Num) + => + forall (_1: seq (tcAdd e p) Init.Datatypes.bool), + FloatNum e p + ) SAWCoreVectorsAsRocqVectors.fpFromBits. -Definition ecFpToBits: forall (e p: Num) (_1: TCFloat e p), +Definition ecFpToBits: forall (e p: Num) (_1: FloatNum e p), seq (tcAdd e p) Init.Datatypes.bool := - fun (e p: Num) (_1: TCFloat e p) - => - SAWCoreScaffolding.error (seq (tcAdd e p) Init.Datatypes.bool) - "Unimplemented: fpToBits"%string - . + floatNumFunction (fun (e p: Num) + => + forall (_1: FloatNum e p), + seq (tcAdd e p) Init.Datatypes.bool + ) SAWCoreVectorsAsRocqVectors.fpToBits. -Definition ecFpEq: forall (e p: Num) (_1 _2: TCFloat e p), +Definition ecFpLogicalEq: forall (e p: Num) (_1 _2: FloatNum e p), Init.Datatypes.bool := - fun (e p: Num) (_1 _2: TCFloat e p) - => - SAWCoreScaffolding.error Init.Datatypes.bool "Unimplemented: =.="%string - . + floatNumFunction (fun (e p: Num) + => + forall (_1 _2: FloatNum e p), + Init.Datatypes.bool + ) SAWCoreScaffolding.fpLogicalEq. -Definition ecFpAdd: forall (e p: Num) (_1: - SAWCoreVectorsAsRocqVectors.Vec - (Stdlib.PArith.BinPos.Pos.to_nat - (Stdlib.PArith.BinPos.xI Stdlib.PArith.BinPos.xH)) - Init.Datatypes.bool) (_2 _3: TCFloat e p), - TCFloat e p := - fun (e p: Num) (_1: - SAWCoreVectorsAsRocqVectors.Vec - (Stdlib.PArith.BinPos.Pos.to_nat - (Stdlib.PArith.BinPos.xI Stdlib.PArith.BinPos.xH)) - Init.Datatypes.bool) (_2 _3: TCFloat e p) - => - SAWCoreScaffolding.error (TCFloat e p) "Unimplemented: fpAdd"%string - . +Definition ecFpAdd: forall (e p: Num) + (_1: SAWCoreVectorsAsRocqVectors.RoundingMode) (_2 _3: FloatNum e p), + FloatNum e p := + floatNumFunction (fun (e p: Num) + => + forall (_1: SAWCoreVectorsAsRocqVectors.RoundingMode) (_2 _3: + FloatNum e p), + FloatNum e p + ) SAWCoreVectorsAsRocqVectors.fpAdd. + +Definition ecFpSub: forall (e p: Num) + (_1: SAWCoreVectorsAsRocqVectors.RoundingMode) (_2 _3: FloatNum e p), + FloatNum e p := + floatNumFunction (fun (e p: Num) + => + forall (_1: SAWCoreVectorsAsRocqVectors.RoundingMode) (_2 _3: + FloatNum e p), + FloatNum e p + ) SAWCoreVectorsAsRocqVectors.fpSub. + +Definition ecFpMul: forall (e p: Num) + (_1: SAWCoreVectorsAsRocqVectors.RoundingMode) (_2 _3: FloatNum e p), + FloatNum e p := + floatNumFunction (fun (e p: Num) + => + forall (_1: SAWCoreVectorsAsRocqVectors.RoundingMode) (_2 _3: + FloatNum e p), + FloatNum e p + ) SAWCoreVectorsAsRocqVectors.fpMul. + +Definition ecFpDiv: forall (e p: Num) + (_1: SAWCoreVectorsAsRocqVectors.RoundingMode) (_2 _3: FloatNum e p), + FloatNum e p := + floatNumFunction (fun (e p: Num) + => + forall (_1: SAWCoreVectorsAsRocqVectors.RoundingMode) (_2 _3: + FloatNum e p), + FloatNum e p + ) SAWCoreVectorsAsRocqVectors.fpDiv. -Definition ecFpSub: forall (e p: Num) (_1: - SAWCoreVectorsAsRocqVectors.Vec - (Stdlib.PArith.BinPos.Pos.to_nat - (Stdlib.PArith.BinPos.xI Stdlib.PArith.BinPos.xH)) - Init.Datatypes.bool) (_2 _3: TCFloat e p), - TCFloat e p := - fun (e p: Num) (_1: - SAWCoreVectorsAsRocqVectors.Vec - (Stdlib.PArith.BinPos.Pos.to_nat - (Stdlib.PArith.BinPos.xI Stdlib.PArith.BinPos.xH)) - Init.Datatypes.bool) (_2 _3: TCFloat e p) - => - SAWCoreScaffolding.error (TCFloat e p) "Unimplemented: fpSub"%string - . +Definition ecFpToRational: forall (e p: Num) (_1: FloatNum e p), + SAWCoreScaffolding.Rational := + floatNumFunction (fun (e p: Num) + => + forall (_1: FloatNum e p), + SAWCoreScaffolding.Rational + ) SAWCoreScaffolding.fpToRational. + +Definition ecFpFromRational: forall (e p: Num) + (_1: SAWCoreVectorsAsRocqVectors.RoundingMode) + (_2: SAWCoreScaffolding.Rational), + FloatNum e p := + floatNumFunction (fun (e p: Num) + => + forall (_1: SAWCoreVectorsAsRocqVectors.RoundingMode) + (_2: SAWCoreScaffolding.Rational), + FloatNum e p + ) SAWCoreVectorsAsRocqVectors.fpFromRational. -Definition ecFpMul: forall (e p: Num) (_1: - SAWCoreVectorsAsRocqVectors.Vec - (Stdlib.PArith.BinPos.Pos.to_nat - (Stdlib.PArith.BinPos.xI Stdlib.PArith.BinPos.xH)) - Init.Datatypes.bool) (_2 _3: TCFloat e p), - TCFloat e p := - fun (e p: Num) (_1: - SAWCoreVectorsAsRocqVectors.Vec - (Stdlib.PArith.BinPos.Pos.to_nat - (Stdlib.PArith.BinPos.xI Stdlib.PArith.BinPos.xH)) - Init.Datatypes.bool) (_2 _3: TCFloat e p) - => - SAWCoreScaffolding.error (TCFloat e p) "Unimplemented: fpMul"%string - . +Definition ecFpIsNaN: forall (e p: Num) (_1: FloatNum e p), + Init.Datatypes.bool := + floatNumFunction (fun (e p: Num) + => + forall (_1: FloatNum e p), + Init.Datatypes.bool + ) SAWCoreScaffolding.fpIsNaN. -Definition ecFpDiv: forall (e p: Num) (_1: - SAWCoreVectorsAsRocqVectors.Vec - (Stdlib.PArith.BinPos.Pos.to_nat - (Stdlib.PArith.BinPos.xI Stdlib.PArith.BinPos.xH)) - Init.Datatypes.bool) (_2 _3: TCFloat e p), - TCFloat e p := - fun (e p: Num) (_1: - SAWCoreVectorsAsRocqVectors.Vec - (Stdlib.PArith.BinPos.Pos.to_nat - (Stdlib.PArith.BinPos.xI Stdlib.PArith.BinPos.xH)) - Init.Datatypes.bool) (_2 _3: TCFloat e p) - => - SAWCoreScaffolding.error (TCFloat e p) "Unimplemented: fpDiv"%string - . +Definition ecFpIsInf: forall (e p: Num) (_1: FloatNum e p), + Init.Datatypes.bool := + floatNumFunction (fun (e p: Num) + => + forall (_1: FloatNum e p), + Init.Datatypes.bool + ) SAWCoreScaffolding.fpIsInf. -Definition ecFpToRational: forall (e p: Num) (_1: TCFloat e p), - SAWCoreScaffolding.Rational := - fun (e p: Num) (_1: TCFloat e p) - => - SAWCoreScaffolding.error SAWCoreScaffolding.Rational - "Unimplemented: fpToRational"%string - . +Definition ecFpIsZero: forall (e p: Num) (_1: FloatNum e p), + Init.Datatypes.bool := + floatNumFunction (fun (e p: Num) + => + forall (_1: FloatNum e p), + Init.Datatypes.bool + ) SAWCoreScaffolding.fpIsZero. -Definition ecFpFromRational: forall (e p: Num) (_1: - SAWCoreVectorsAsRocqVectors.Vec - (Stdlib.PArith.BinPos.Pos.to_nat - (Stdlib.PArith.BinPos.xI Stdlib.PArith.BinPos.xH)) - Init.Datatypes.bool) (_2: SAWCoreScaffolding.Rational), - TCFloat e p := - fun (e p: Num) (_1: - SAWCoreVectorsAsRocqVectors.Vec - (Stdlib.PArith.BinPos.Pos.to_nat - (Stdlib.PArith.BinPos.xI Stdlib.PArith.BinPos.xH)) - Init.Datatypes.bool) (_2: SAWCoreScaffolding.Rational) - => - SAWCoreScaffolding.error (TCFloat e p) - "Unimplemented: fpFromRational"%string - . +Definition ecFpIsNeg: forall (e p: Num) (_1: FloatNum e p), + Init.Datatypes.bool := + floatNumFunction (fun (e p: Num) + => + forall (_1: FloatNum e p), + Init.Datatypes.bool + ) SAWCoreScaffolding.fpIsNeg. -Definition fpIsNaN: forall (e p: Num) (_1: TCFloat e p), Init.Datatypes.bool := - fun (e p: Num) (x: TCFloat e p) - => - SAWCoreScaffolding.error Init.Datatypes.bool - "Unimplemented: fpIsNaN"%string - . +Definition ecFpIsNormal: forall (e p: Num) (_1: FloatNum e p), + Init.Datatypes.bool := + floatNumFunction (fun (e p: Num) + => + forall (_1: FloatNum e p), + Init.Datatypes.bool + ) SAWCoreScaffolding.fpIsNormal. -Definition fpIsInf: forall (e p: Num) (_1: TCFloat e p), Init.Datatypes.bool := - fun (e p: Num) (x: TCFloat e p) - => - SAWCoreScaffolding.error Init.Datatypes.bool - "Unimplemented: fpIsInf"%string - . +Definition ecFpIsSubnormal: forall (e p: Num) (_1: FloatNum e p), + Init.Datatypes.bool := + floatNumFunction (fun (e p: Num) + => + forall (_1: FloatNum e p), + Init.Datatypes.bool + ) SAWCoreScaffolding.fpIsSubnormal. -Definition fpIsZero: forall (e p: Num) (_1: TCFloat e p), Init.Datatypes.bool := - fun (e p: Num) (x: TCFloat e p) - => - SAWCoreScaffolding.error Init.Datatypes.bool - "Unimplemented: fpIsZero"%string - . +Definition ecFpFMA: forall (e p: Num) + (_1: SAWCoreVectorsAsRocqVectors.RoundingMode) (_2 _3 _4: FloatNum e p), + FloatNum e p := + floatNumFunction (fun (e p: Num) + => + forall (_1: SAWCoreVectorsAsRocqVectors.RoundingMode) (_2 _3 _4: + FloatNum e p), + FloatNum e p + ) SAWCoreVectorsAsRocqVectors.fpFMA. + +Definition ecFpAbs: forall (e p: Num) (_1: FloatNum e p), FloatNum e p := + floatNumFunction (fun (e p: Num) => forall (_1: FloatNum e p), FloatNum e p) + SAWCoreScaffolding.fpAbs. + +Definition ecFpSqrt: forall (e p: Num) + (_1: SAWCoreVectorsAsRocqVectors.RoundingMode) (_2: FloatNum e p), + FloatNum e p := + floatNumFunction (fun (e p: Num) + => + forall (_1: SAWCoreVectorsAsRocqVectors.RoundingMode) (_2: + FloatNum e p), + FloatNum e p + ) SAWCoreVectorsAsRocqVectors.fpSqrt. -Definition fpIsNeg: forall (e p: Num) (_1: TCFloat e p), Init.Datatypes.bool := - fun (e p: Num) (x: TCFloat e p) - => - SAWCoreScaffolding.error Init.Datatypes.bool - "Unimplemented: fpIsNeg"%string - . +Definition PEqFloatNum: forall (e p: Num), PEq (FloatNum e p) := + floatNumFunction (fun (e p: Num) => PEq (FloatNum e p)) PEqFloat. -Definition fpIsNormal: forall (e p: Num) (_1: TCFloat e p), - Init.Datatypes.bool := - fun (e p: Num) (x: TCFloat e p) - => - SAWCoreScaffolding.error Init.Datatypes.bool - "Unimplemented: fpIsNormal"%string - . +Definition PCmpFloatNum: forall (e p: Num), PCmp (FloatNum e p) := + floatNumFunction (fun (e p: Num) => PCmp (FloatNum e p)) PCmpFloat. -Definition fpIsSubnormal: forall (e p: Num) (_1: TCFloat e p), - Init.Datatypes.bool := - fun (e p: Num) (x: TCFloat e p) - => - SAWCoreScaffolding.error Init.Datatypes.bool - "Unimplemented: fpIsSubnormal"%string - . +Definition PZeroFloatNum: forall (e p: Num), PZero (FloatNum e p) := + floatNumFunction (fun (e p: Num) => PZero (FloatNum e p)) PZeroFloat. -Definition fpFMA: forall (e p: Num) (_1: - SAWCoreVectorsAsRocqVectors.Vec - (Stdlib.PArith.BinPos.Pos.to_nat - (Stdlib.PArith.BinPos.xI Stdlib.PArith.BinPos.xH)) - Init.Datatypes.bool) (_2 _3 _4: TCFloat e p), - TCFloat e p := - fun (e p: Num) (r: - SAWCoreVectorsAsRocqVectors.Vec - (Stdlib.PArith.BinPos.Pos.to_nat - (Stdlib.PArith.BinPos.xI Stdlib.PArith.BinPos.xH)) - Init.Datatypes.bool) (x y z: TCFloat e p) - => - SAWCoreScaffolding.error (TCFloat e p) "Unimplemented: fpFMA"%string - . +Definition PRingFloatNum: forall (e p: Num), PRing (FloatNum e p) := + floatNumFunction (fun (e p: Num) => PRing (FloatNum e p)) PRingFloat. -Definition fpAbs: forall (e p: Num) (_1: TCFloat e p), TCFloat e p := - fun (e p: Num) (x: TCFloat e p) - => - SAWCoreScaffolding.error (TCFloat e p) "Unimplemented: fpAbs"%string - . +Definition PFieldFloatNum: forall (e p: Num), PField (FloatNum e p) := + floatNumFunction (fun (e p: Num) => PField (FloatNum e p)) PFieldFloat. -Definition fpSqrt: forall (e p: Num) (_1: - SAWCoreVectorsAsRocqVectors.Vec - (Stdlib.PArith.BinPos.Pos.to_nat - (Stdlib.PArith.BinPos.xI Stdlib.PArith.BinPos.xH)) - Init.Datatypes.bool) (_2: TCFloat e p), - TCFloat e p := - fun (e p: Num) (r: - SAWCoreVectorsAsRocqVectors.Vec - (Stdlib.PArith.BinPos.Pos.to_nat - (Stdlib.PArith.BinPos.xI Stdlib.PArith.BinPos.xH)) - Init.Datatypes.bool) (x: TCFloat e p) - => - SAWCoreScaffolding.error (TCFloat e p) "Unimplemented: fpSqrt"%string - . +Definition PRoundFloatNum: forall (e p: Num), PRound (FloatNum e p) := + floatNumFunction (fun (e p: Num) => PRound (FloatNum e p)) PRoundFloat. + +Definition PLiteralFloatNum: forall (e p: Num), PLiteral (FloatNum e p) := + floatNumFunction (fun (e p: Num) => PLiteral (FloatNum e p)) PLiteralFloat. + +Definition PFLiteralFloatNum: forall (e p: Num), PFLiteral (FloatNum e p) := + floatNumFunction (fun (e p: Num) => PFLiteral (FloatNum e p)) PFLiteralFloat. Definition ecUpdate: forall (n: Num) (a: Type) {Inh_a: SAWCoreScaffolding.Inhabited a} (ix: Type) (_1: PIntegral ix) (_2: diff --git a/otherTests/saw-core-rocq/test_prelude_1.v.good b/otherTests/saw-core-rocq/test_prelude_1.v.good index 4f4c96b661..d3d5fe8841 100644 --- a/otherTests/saw-core-rocq/test_prelude_1.v.good +++ b/otherTests/saw-core-rocq/test_prelude_1.v.good @@ -3531,14 +3531,6 @@ Definition updBvFun: forall (n: Init.Datatypes.nat) (a: Type) (_1: forall (_1: f x . -(* "Prelude::Float@core" was skipped *) - -(* "Prelude::mkFloat@core" was skipped *) - -(* "Prelude::Double@core" was skipped *) - -(* "Prelude::mkDouble@core" was skipped *) - (* "Prelude::List" was skipped *) (* "Prelude::List__rec@core" was skipped *) @@ -4181,6 +4173,160 @@ Definition rationalRoundToEven: forall (_1: SAWCoreScaffolding.Rational), var__1 . +(* "Prelude::Float@core" was skipped *) + +(* "Prelude::RoundingMode@core" was skipped *) + +Definition roundNearestEven: SAWCoreVectorsAsRocqVectors.RoundingMode := + SAWCoreVectorsAsRocqVectors.bvNat + (Stdlib.PArith.BinPos.Pos.to_nat + (Stdlib.PArith.BinPos.xI Stdlib.PArith.BinPos.xH)) + SAWCoreScaffolding.Zero. + +Definition roundNearestAway: SAWCoreVectorsAsRocqVectors.RoundingMode := + SAWCoreVectorsAsRocqVectors.bvNat + (Stdlib.PArith.BinPos.Pos.to_nat + (Stdlib.PArith.BinPos.xI Stdlib.PArith.BinPos.xH)) + (Stdlib.PArith.BinPos.Pos.to_nat Stdlib.PArith.BinPos.xH). + +Definition roundPositive: SAWCoreVectorsAsRocqVectors.RoundingMode := + SAWCoreVectorsAsRocqVectors.bvNat + (Stdlib.PArith.BinPos.Pos.to_nat + (Stdlib.PArith.BinPos.xI Stdlib.PArith.BinPos.xH)) + (Stdlib.PArith.BinPos.Pos.to_nat + (Stdlib.PArith.BinPos.xO Stdlib.PArith.BinPos.xH)). + +Definition roundNegative: SAWCoreVectorsAsRocqVectors.RoundingMode := + SAWCoreVectorsAsRocqVectors.bvNat + (Stdlib.PArith.BinPos.Pos.to_nat + (Stdlib.PArith.BinPos.xI Stdlib.PArith.BinPos.xH)) + (Stdlib.PArith.BinPos.Pos.to_nat + (Stdlib.PArith.BinPos.xI Stdlib.PArith.BinPos.xH)). + +Definition roundZero: SAWCoreVectorsAsRocqVectors.RoundingMode := + SAWCoreVectorsAsRocqVectors.bvNat + (Stdlib.PArith.BinPos.Pos.to_nat + (Stdlib.PArith.BinPos.xI Stdlib.PArith.BinPos.xH)) + (Stdlib.PArith.BinPos.Pos.to_nat + (Stdlib.PArith.BinPos.xO + (Stdlib.PArith.BinPos.xO Stdlib.PArith.BinPos.xH))). + +Definition rne: SAWCoreVectorsAsRocqVectors.RoundingMode := + roundNearestEven. + +Definition rna: SAWCoreVectorsAsRocqVectors.RoundingMode := + roundNearestAway. + +Definition rtp: SAWCoreVectorsAsRocqVectors.RoundingMode := + roundPositive. + +Definition rtn: SAWCoreVectorsAsRocqVectors.RoundingMode := + roundNegative. + +Definition rtz: SAWCoreVectorsAsRocqVectors.RoundingMode := + roundZero. + +(* "Prelude::fpNaN@core" was skipped *) + +(* "Prelude::fpPosInf@core" was skipped *) + +(* "Prelude::fpFromBits@core" was skipped *) + +(* "Prelude::fpToBits@core" was skipped *) + +(* "Prelude::fpLogicalEq@core" was skipped *) + +(* "Prelude::fpIsNaN@core" was skipped *) + +(* "Prelude::fpIsInf@core" was skipped *) + +(* "Prelude::fpIsZero@core" was skipped *) + +(* "Prelude::fpIsNeg@core" was skipped *) + +(* "Prelude::fpIsNormal@core" was skipped *) + +(* "Prelude::fpIsSubnormal@core" was skipped *) + +(* "Prelude::fpAdd@core" was skipped *) + +(* "Prelude::fpSub@core" was skipped *) + +(* "Prelude::fpMul@core" was skipped *) + +(* "Prelude::fpDiv@core" was skipped *) + +(* "Prelude::fpFMA@core" was skipped *) + +(* "Prelude::fpAbs@core" was skipped *) + +(* "Prelude::fpSqrt@core" was skipped *) + +(* "Prelude::fpToRational@core" was skipped *) + +(* "Prelude::fpFromRational@core" was skipped *) + +(* "Prelude::fpPosZero@core" was skipped *) + +(* "Prelude::fpIeeeEq@core" was skipped *) + +(* "Prelude::fpLt@core" was skipped *) + +Definition fpLe: forall (e p: Init.Datatypes.nat) (_1 _2: + SAWCoreScaffolding.Float e p), + Init.Datatypes.bool := + fun (e p: Init.Datatypes.nat) (x y: SAWCoreScaffolding.Float e p) + => + Init.Datatypes.orb (SAWCoreScaffolding.fpIeeeEq e p x y) + (SAWCoreScaffolding.fpLt e p x y) + . + +Definition fpCmp: forall (e p: Init.Datatypes.nat) (_1 _2: + SAWCoreScaffolding.Float e p) (_3: Init.Datatypes.bool), + Init.Datatypes.bool := + fun (e p: Init.Datatypes.nat) (x y: SAWCoreScaffolding.Float e p) + (k: Init.Datatypes.bool) + => + Init.Datatypes.orb (SAWCoreScaffolding.fpLt e p x y) + (Init.Datatypes.andb (SAWCoreScaffolding.fpIeeeEq e p x y) k) + . + +(* "Prelude::fpNeg@core" was skipped *) + +(* "Prelude::fpFromInteger@core" was skipped *) + +(* "Prelude::fpToInteger@core" was skipped *) + +(* "Prelude::fpIsPos@core" was skipped *) + +(* "Prelude::fpRem@core" was skipped *) + +(* "Prelude::fpCast@core" was skipped *) + +(* "Prelude::fpRound@core" was skipped *) + +(* "Prelude::fpFromBV@core" was skipped *) + +(* "Prelude::fpFromSBV@core" was skipped *) + +(* "Prelude::fpToBV@core" was skipped *) + +(* "Prelude::fpToSBV@core" was skipped *) + +Definition fpNegInf: forall (e p: Init.Datatypes.nat), + SAWCoreScaffolding.Float e p := + fun (e p: Init.Datatypes.nat) + => + SAWCoreScaffolding.fpNeg e p (SAWCoreScaffolding.fpPosInf e p) + . + +Definition fpNegZero: forall (e p: Init.Datatypes.nat), + SAWCoreScaffolding.Float e p := + fun (e p: Init.Datatypes.nat) + => + SAWCoreScaffolding.fpNeg e p (SAWCoreScaffolding.fpPosZero e p) + . + (* "Prelude::bveq_sameL@core" was skipped *) (* "Prelude::bveq_sameR@core" was skipped *) diff --git a/saw-central/src/SAWCentral/Prover/Exporter.hs b/saw-central/src/SAWCentral/Prover/Exporter.hs index 29b9ac4499..86e1e7460c 100644 --- a/saw-central/src/SAWCentral/Prover/Exporter.hs +++ b/saw-central/src/SAWCentral/Prover/Exporter.hs @@ -422,10 +422,17 @@ rocqTranslationConfiguration renamings skips = Rocq.TranslationConfiguration , Rocq.vectorModule = "SAWCoreVectorsAsRocqVectors" } +withImportIEEE754BinarySingleNaN :: Rocq.TranslationConfiguration -> Rocq.TranslationConfiguration +withImportIEEE754BinarySingleNaN config@(Rocq.TranslationConfiguration { Rocq.postPreamble }) = + config { + Rocq.postPreamble = postPreamble <> + "From Flocq Require IEEE754.BinarySingleNaN.\n" + } + withImportSAWCorePrelude :: Rocq.TranslationConfiguration -> Rocq.TranslationConfiguration withImportSAWCorePrelude config@(Rocq.TranslationConfiguration { Rocq.postPreamble }) = config { - Rocq.postPreamble = postPreamble <> + Rocq.postPreamble = postPreamble <> "From CryptolToRocq Require Import SAWCorePrelude.\n" } @@ -578,6 +585,7 @@ writeRocqCryptolPrimitivesForSAWCore cryFile notations skips = do let configuration = withImportSAWCorePreludeExtra $ withImportSAWCorePrelude $ + withImportIEEE754BinarySingleNaN $ rocqTranslationConfiguration notations skips m' <- Rocq.translateSAWModule sc configuration mm m let doc = PP.vcat [ Rocq.preamble configuration, m'] diff --git a/saw-core-aig/src/SAWCoreAIG/BitBlast.hs b/saw-core-aig/src/SAWCoreAIG/BitBlast.hs index 281c594eca..cacd6bcbf8 100644 --- a/saw-core-aig/src/SAWCoreAIG/BitBlast.hs +++ b/saw-core-aig/src/SAWCoreAIG/BitBlast.hs @@ -173,6 +173,7 @@ prims be = , Prims.bpMuxBool = \b x y -> AIG.lazyMux be b (pure x) (pure y) , Prims.bpMuxWord = \b x y -> AIG.iteM be b (pure x) (pure y) , Prims.bpMuxInt = muxInt + , Prims.bpMuxFloat = unsupportedAIGPrimitive "bpMuxFloat" , Prims.bpMuxArray = unsupportedAIGPrimitive "bpMuxArray" , Prims.bpMuxExtra = muxBExtra be -- Booleans @@ -238,6 +239,42 @@ prims be = , Prims.bpIntMax = pure2 max , Prims.bpNatToInt = pure1 toInteger + -- Float operations + , Prims.bpFpAbs = unsupportedAIGPrimitive "bpFpAbs" + , Prims.bpFpAdd = unsupportedAIGPrimitive "bpFpAdd" + , Prims.bpFpCast = unsupportedAIGPrimitive "bpFpCast" + , Prims.bpFpDiv = unsupportedAIGPrimitive "bpFpDiv" + , Prims.bpFpFMA = unsupportedAIGPrimitive "bpFpFMA" + , Prims.bpFpFromBits = unsupportedAIGPrimitive "bpFpFromBits" + , Prims.bpFpFromBV = unsupportedAIGPrimitive "bpFpFromBV" + , Prims.bpFpFromInteger = unsupportedAIGPrimitive "bpFpFromInteger" + , Prims.bpFpFromRational = unsupportedAIGPrimitive "bpFpFromRational" + , Prims.bpFpFromSBV = unsupportedAIGPrimitive "bpFpFromSBV" + , Prims.bpFpIeeeEq = unsupportedAIGPrimitive "bpFpIeeeEq" + , Prims.bpFpIsInf = unsupportedAIGPrimitive "bpFpIsInf" + , Prims.bpFpIsNaN = unsupportedAIGPrimitive "bpFpIsNaN" + , Prims.bpFpIsNeg = unsupportedAIGPrimitive "bpFpIsNeg" + , Prims.bpFpIsNormal = unsupportedAIGPrimitive "bpFpIsNormal" + , Prims.bpFpIsPos = unsupportedAIGPrimitive "bpFpIsPos" + , Prims.bpFpIsSubnormal = unsupportedAIGPrimitive "bpFpIsSubnormal" + , Prims.bpFpIsZero = unsupportedAIGPrimitive "bpFpIsZero" + , Prims.bpFpLt = unsupportedAIGPrimitive "bpFpLt" + , Prims.bpFpLogicalEq = unsupportedAIGPrimitive "bpFpLogicalEq" + , Prims.bpFpMul = unsupportedAIGPrimitive "bpFpMul" + , Prims.bpFpNaN = unsupportedAIGPrimitive "bpFpNaN" + , Prims.bpFpNeg = unsupportedAIGPrimitive "bpFpNeg" + , Prims.bpFpPosInf = unsupportedAIGPrimitive "bpFpPosInf" + , Prims.bpFpPosZero = unsupportedAIGPrimitive "bpFpPosZero" + , Prims.bpFpRem = unsupportedAIGPrimitive "bpFpRem" + , Prims.bpFpRound = unsupportedAIGPrimitive "bpFpRound" + , Prims.bpFpSqrt = unsupportedAIGPrimitive "bpFpSqrt" + , Prims.bpFpSub = unsupportedAIGPrimitive "bpFpSub" + , Prims.bpFpToBits = unsupportedAIGPrimitive "bpFpToBits" + , Prims.bpFpToBV = unsupportedAIGPrimitive "bpFpToBV" + , Prims.bpFpToInteger = unsupportedAIGPrimitive "bpFpToInteger" + , Prims.bpFpToRational = unsupportedAIGPrimitive "bpFpToRational" + , Prims.bpFpToSBV = unsupportedAIGPrimitive "bpFpToSBV" + -- Array operations , Prims.bpArrayConstant = unsupportedAIGPrimitive "bpArrayConstant" , Prims.bpArrayLookup = unsupportedAIGPrimitive "bpArrayLookup" diff --git a/saw-core-rocq/README.md b/saw-core-rocq/README.md index c86a06897c..36ed3a3cb5 100644 --- a/saw-core-rocq/README.md +++ b/saw-core-rocq/README.md @@ -17,9 +17,10 @@ support libraries must be compiled by Rocq in order to use them. ## Installing Dependencies To compile the Rocq support libraries, Rocq must be installed, as must the -following library: +following libraries: * [coq-bits](https://github.com/rocq-community/bits) +* [coq-flocq](https://gitlab.inria.fr/flocq/flocq) The recommended way to install Rocq and these dependencies is using `opam`. This can be done with the following steps, which will not only install `opam`, Rocq, and @@ -35,12 +36,14 @@ opam install rocq-core=9.1.0 rocq-stdlib=9.0.0 opam repo add rocq-released https://rocq-prover.org/opam/released ``` -Installing the required version of `coq-bits` (linked above) also requires -installing the `coq` package, which includes compatibility shims to support the -Coq to Rocq transition (e.g. the `coqc` and `coq_makefile` executables): +Installing the required versions of `coq-bits` and `coq-flocq` (linked above) +also requires installing the `coq` package, which includes compatibility shims +to support the Coq to Rocq transition (e.g. the `coqc` and `coq_makefile` +executables): ``` opam install coq=9.1.0 opam pin coq-bits https://github.com/rocq-community/bits.git#f50fc3e5f1eabcb0b0b94c8d25f75e61a255c2ba +opam pin coq-flocq https://gitlab.inria.fr/flocq/flocq.git#27143972fc1dc96e281626d5194b5b371f05db80 ``` If you run into any issue that is probably due to the version mismatch between the `ocamlc` diff --git a/saw-core-rocq/rocq/_RocqProject b/saw-core-rocq/rocq/_RocqProject index 6d28f7bdc4..6f0cccd886 100644 --- a/saw-core-rocq/rocq/_RocqProject +++ b/saw-core-rocq/rocq/_RocqProject @@ -6,6 +6,8 @@ generated/CryptolToRocq/CryptolPrimitivesForSAWCore.v handwritten/CryptolToRocq/RocqVectorsExtra.v handwritten/CryptolToRocq/CryptolPrimitivesForSAWCoreExtra.v +handwritten/CryptolToRocq/IEEE754/BitsExtra.v +handwritten/CryptolToRocq/IEEE754/BitsSingleNaN.v handwritten/CryptolToRocq/SAWCoreBitvectors.v handwritten/CryptolToRocq/SAWCoreBitvectorsZifyU64.v handwritten/CryptolToRocq/SAWCorePrelude_proofs.v diff --git a/saw-core-rocq/rocq/handwritten/CryptolToRocq/IEEE754/BitsExtra.v b/saw-core-rocq/rocq/handwritten/CryptolToRocq/IEEE754/BitsExtra.v new file mode 100644 index 0000000000..a316ddb7ae --- /dev/null +++ b/saw-core-rocq/rocq/handwritten/CryptolToRocq/IEEE754/BitsExtra.v @@ -0,0 +1,52 @@ +(** + * This generalizes the default_nan_pl{32,64} definitions from IEEE754.Bits to + * work over any precision. + *) + +From Stdlib Require Import Lia SpecFloat ZArith. +From Flocq Require Import Core IEEE754.Binary. + +Lemma digits2_pos_iter_nat (n : nat) : + SpecFloat.digits2_pos (Zaux.iter_nat xO n 1%positive) = Pos.of_succ_nat n. +Proof. +induction n. +- easy. +- rewrite Zaux.iter_nat_S. + simpl. + now rewrite IHn. +Qed. + +Section Binary_Bits_Extra. + +Arguments exist {A} {P}. +Arguments B754_nan {prec} {emax}. + +(** Number of bits for the fraction and exponent *) +Variable mw ew : positive. + +Let prec := Z.pos (Pos.succ mw). +Let emax := Zpower 2 (Z.pos ew - 1). +Notation binary_float := (binary_float prec emax) (only parsing). + +Definition default_pl : positive := + Zaux.iter_nat xO (Z.to_nat (prec - 2)) 1%positive. + +Lemma nan_pl_default_pl : + nan_pl prec default_pl = true. +Proof. +unfold nan_pl, default_pl, prec'. +rewrite digits2_pos_iter_nat. +rewrite Zpos_P_of_succ_nat. +rewrite (Z2Nat.id (prec - 2)). +- change (prec - 2)%Z with (prec + (-1 + -1))%Z. + rewrite Z.add_assoc. + change (prec + -1 + -1)%Z with (Z.pred (prec - 1))%Z. + rewrite <- (Zsucc_pred (prec - 1)). + lia. +- lia. +Qed. + +Definition default_nan_pl : { nan : binary_float | is_nan prec emax nan = true } := + exist (B754_nan false default_pl nan_pl_default_pl) (refl_equal true). + +End Binary_Bits_Extra. diff --git a/saw-core-rocq/rocq/handwritten/CryptolToRocq/IEEE754/BitsSingleNaN.v b/saw-core-rocq/rocq/handwritten/CryptolToRocq/IEEE754/BitsSingleNaN.v new file mode 100644 index 0000000000..433cbc762d --- /dev/null +++ b/saw-core-rocq/rocq/handwritten/CryptolToRocq/IEEE754/BitsSingleNaN.v @@ -0,0 +1,41 @@ +(** + * This is an adaptation of IEEE754.Bits from the Flocq library that works + * over BinarySingleNaN (i.e., a IEEE-754 floating-point type with a single, + * distinguished NaN value) instead of Binary (which permits multiple, distinct + * NaN values). Arguably, this should be upstreamed into Flocq itself. + *) + +From Stdlib Require Import ZArith Reals Psatz SpecFloat. + +From Flocq Require Import Core Round Bracket Operations Div Sqrt Relative BinarySingleNaN. + +From Flocq Require Binary Bits. + +Section Binary_Bits. + +(** Number of bits for the fraction and exponent *) +Variable mw ew : positive. + +Let prec := Z.pos (Pos.succ mw). +Let emax := Zpower 2 (Z.pos ew - 1). +Notation binary_float := (binary_float prec emax) (only parsing). + +Hypothesis Hmax : (1 < emax)%Z. + +Definition bits_of_binary_float (nan : { nan : Binary.binary_float prec emax | Binary.is_nan prec emax nan = true }) (x : binary_float) : Z := + Bits.bits_of_binary_float mw ew (Binary.BSN2B prec emax nan x). + +Definition bits_of_binary_float' (x : binary_float) (Nx : is_nan x = false) : Z := + Bits.bits_of_binary_float mw ew (Binary.BSN2B' prec emax x Nx). + +Definition split_bits_of_binary_float (nan : { nan : Binary.binary_float prec emax | Binary.is_nan prec emax nan = true +}) (x : binary_float) : bool * Z * Z := + Bits.split_bits_of_binary_float mw ew (Binary.BSN2B prec emax nan x). + +Definition split_bits_of_binary_float' (x : binary_float) (Nx : is_nan x = false) : bool * Z * Z := + Bits.split_bits_of_binary_float mw ew (Binary.BSN2B' prec emax x Nx). + +Definition binary_float_of_bits (x : Z) : binary_float := + Binary.B2BSN prec emax (Bits.binary_float_of_bits mw ew Hmax x). + +End Binary_Bits. diff --git a/saw-core-rocq/rocq/handwritten/CryptolToRocq/SAWCoreScaffolding.v b/saw-core-rocq/rocq/handwritten/CryptolToRocq/SAWCoreScaffolding.v index 4476fd688a..d1ab3c59ac 100644 --- a/saw-core-rocq/rocq/handwritten/CryptolToRocq/SAWCoreScaffolding.v +++ b/saw-core-rocq/rocq/handwritten/CryptolToRocq/SAWCoreScaffolding.v @@ -1,11 +1,18 @@ From Stdlib Require Import ZArith. From Stdlib Require Import NArith. From Stdlib Require Import QArith.QArith_base. +From Stdlib Require Import QArith.Qround. From Stdlib Require Import Lists.List. From Stdlib Require Numbers.NatInt.NZLog. From Stdlib Require Import Strings.String. From Stdlib Require Export Logic.Eqdep. From Stdlib Require Import Arith. +From Stdlib Require Import Lia. +#[local] Set Warnings "stdlib-vector". +From Flocq Require Import IEEE754.BinarySingleNaN. + +From CryptolToRocq Require Import IEEE754.BitsExtra. +From CryptolToRocq Require Import IEEE754.BitsSingleNaN. (* This defines notations that clash with nat's notations. *) Close Scope Q_scope. @@ -444,6 +451,236 @@ Definition rationalRecip : Rational -> Rational := Qinv. Definition rationalFloor (r : Rational) : Integer := (Qnum r / Zpos (Qden r))%Z. +(*** + *** Floats + ***) + +(* We use the Flocq library to formalize IEEE-754 floating-point values. + * Specifically, we use IEEE754.BinarySingleNaN's binary_float float, which + * encodes floats with a single, distinguished NaN value. Flocq provides most + * (but not all) operations that SAWCore needs. + * + * This is defined in a very specific way so that it can be substituted into + * the type of binary_float_of_bits without needing to perform rewrites in + * order to make the type-level numbers equal. + *) +Definition Float (e p : nat) := + binary_float (Z.pos (Pos.succ (Pos.of_nat p - 1))) (2 ^ (Z.pos (Pos.of_nat e) - 1)). + +Global Instance Inhabited_binary_float (prec emax : Z) : Inhabited (binary_float prec emax) := + MkInhabited (binary_float prec emax) (B754_zero false). +Global Instance Inhabited_Float (e p : nat) : Inhabited (Float e p) := + MkInhabited (Float e p) (B754_zero false). + +(* Float operations. Note that Flocq has no knowledge of our Vec or + * RoundingMode types, so some operations below are instead defined in terms of + * Z (for bitvector-related operations) or mode (for operations that may + * perform rounding). In CryptolToRocq.SAWCoreVectorsAsRocqVectors, we define + * wrapper functions that interface with our bitvector-related types. + *) + +Definition fpAbs (e p : nat) : Float e p -> Float e p := + Babs. + +Definition fpAdd_mode (e p : nat) : mode -> Float e p -> Float e p -> Float e p := + Bplus. + +Definition fpDiv_mode (e p : nat) : mode -> Float e p -> Float e p -> Float e p := + Bdiv. + +Definition fpFMA_mode (e p : nat) : mode -> Float e p -> Float e p -> Float e p -> Float e p := + Bfma. + +(* A helper lemma used in the definition of fpFromBits_Z. *) +Theorem emax_gt_1 (e : nat) : (1 < 2 ^ (Z.pos (Pos.of_nat (S (S e))) - 1))%Z. +Proof. +change 1%Z with (2^(1 - 1))%Z at 1. +apply Z.pow_lt_mono_r; lia. +Qed. + +(* While most of Flocq's binary_float operations work on any number of exponent + * or precision bits, binary_float_of_bits is an exception, as it requires at + * least 2 exponent bits. To accomplish this, we match on the number of + * exponent bits below, and if the number of bits is too small, then we return + * an unspecified value. This makes the Rocq version more well-defined than + * SAWCore's version. + *) +Definition fpFromBits_Z (e p : nat) (bits : Z) : Float e p := + match e with + | S (S e') => binary_float_of_bits _ _ (emax_gt_1 e') bits + | _ => B754_zero false + end. + +Definition fpFromInteger_mode (e p : nat) (rm : mode) (z : Z) : Float e p := + binary_normalize _ _ rm z 0 false. + +Definition fpFromRational_mode (e p : nat) (rm : mode) (q : Q) : Float e p := + match Qnum q with + | Z0 => B754_zero false + | Zpos num => SF2B _ (proj1 (Bdiv_correct_aux _ _ rm false num 0 false (Qden q) 0)) + | Zneg num => SF2B _ (proj1 (Bdiv_correct_aux _ _ rm true num 0 false (Qden q) 0)) + end. + +Definition fpIeeeEq (e p : nat) : Float e p -> Float e p -> bool := + Beqb. + +Definition fpIsInf (e p : nat) (f : Float e p) : bool := + match f with + | B754_infinity _ => true + | _ => false + end. + +Definition fpIsNaN (e p : nat) (f : Float e p) : bool := + is_nan f. + +Definition fpIsNeg (e p : nat) (f : Float e p) : bool := + match f with + | B754_nan => false + | B754_infinity neg => neg + | B754_finite neg _ _ _ => neg + | B754_zero neg => neg + end. + +(* This should probably be defined in SpecFloat, but isn't *) +Definition SFnormal (prec : Z) (m : positive) : bool := + (SpecFloat.digits2_pos m =? Z.to_pos prec)%positive. + +Definition fpIsNormal (e p : nat) (f : Float e p) : bool := + match f with + | B754_nan => false + | B754_infinity _ => false + | B754_finite _ m _ _ => SFnormal (Z.pos (Pos.succ (Pos.of_nat p - 1))) m + | B754_zero _ => false + end. + +Definition fpIsPos (e p : nat) (f : Float e p) : bool := + match f with + | B754_nan => false + | B754_infinity neg => negb neg + | B754_finite neg _ _ _ => negb neg + | B754_zero neg => negb neg + end. + +Definition fpIsSubnormal (e p : nat) (f : Float e p) : bool := + match f with + | B754_nan => false + | B754_infinity _ => false + | B754_finite _ m _ _ => negb (SFnormal (Z.pos (Pos.succ (Pos.of_nat p - 1))) m) + | B754_zero _ => false + end. + +Definition fpIsZero (e p : nat) (f : Float e p) : bool := + match f with + | B754_zero _ => true + | _ => false + end. + +Definition fpLogicalEq (e p : nat) (f1 : Float e p) (f2 : Float e p) : bool := + match f1, f2 with + | B754_nan, B754_nan => true + | B754_infinity neg1, B754_infinity neg2 => Bool.eqb neg1 neg2 + | B754_finite s1 m1 e1 _, B754_finite s2 m2 e2 _ => andb (Bool.eqb s1 s2) (andb (Pos.eqb m1 m2) (Z.eqb e1 e2)) + | B754_zero neg1, B754_zero neg2 => Bool.eqb neg1 neg2 + + | B754_nan, _ => false + | B754_infinity _, _ => false + | B754_finite _ _ _ _, _ => false + | B754_zero _, _ => false + end. + +Definition fpLt (e p : nat) : Float e p -> Float e p -> bool := + Bltb. + +Definition fpMul_mode (e p : nat) : mode -> Float e p -> Float e p -> Float e p := + Bmult. + +Definition fpNaN (e p : nat) : Float e p := + B754_nan. + +Definition fpNeg (e p : nat) : Float e p -> Float e p := + Bopp. + +Definition fpPosInf (e p : nat) : Float e p := + B754_infinity false. + +Definition fpPosZero (e p : nat) : Float e p := + B754_zero false. + +Definition fpSqrt_mode (e p : nat) : mode -> Float e p -> Float e p := + Bsqrt. + +Definition fpSub_mode (e p : nat) : mode -> Float e p -> Float e p -> Float e p := + Bminus. + +Definition fpToBits_Z (e p : nat) (f : Float e p) : Z := + bits_of_binary_float _ _ (default_nan_pl _ _) f. + +(* Adapted from Flocq's Btrunc, but generalized to work over any rounding mode. + * Note that this is more well-defined than SAWCore's implementation of + * fpToInteger, which will error if given an infinite or NaN argument. This + * Rocq implementation will instead return an unspecified result. + *) +Definition fpToInteger_mode (e p : nat) (rm : mode) (f : Float e p) : Z := + match f with + | B754_finite s m e' _ => + SpecFloat.cond_Zopp s (SFnearbyint_binary_aux (Z.pos (Pos.succ (Pos.of_nat p - 1))) rm s m e') + | _ => 0 + end. + +(* Note that this is more well-defined than SAWCore's implementation of + * fpToRational, which will error if given an infinite or NaN argument. This + * Rocq implementation will instead return an unspecified result. + *) +Definition fpToRational (e p : nat) (f : Float e p) : Q := + match f with + | B754_finite s m e' _ => + let q := (inject_Z (Zpos m) * Qpower 2 e')%Q in + if s then Qopp q else q + | _ => 0 + end. + +(* Flocq lacks implementations of the following, so we provide (likely + * inefficient) reference implementations below. + *) + +Definition fpCast_mode (e1 p1 e2 p2 : nat) (rm : mode) (f : Float e1 p1) : Float e2 p2 := + match f with + | B754_nan => B754_nan + | B754_infinity neg => B754_infinity neg + | B754_zero neg => B754_zero neg + | B754_finite _ _ _ _ => fpFromRational_mode e2 p2 rm (fpToRational e1 p1 f) + end. + +Definition Qfloor_frac_part (x:Q) := let (n,d) := x in Qmake (Z.modulo n (Zpos d)) d. + +(* Surprisingly, Qround doesn't define this + * (see https://github.com/rocq-prover/stdlib/issues/283) + *) +Definition Qround_to_even (x:Q) := + match Qcompare (Qfloor_frac_part x) 0.5 with + | Datatypes.Lt => Qfloor x + | Datatypes.Gt => Qceiling x + | Datatypes.Eq => if Z.even (Qfloor x) then Qfloor x else Qceiling x + end. + +Definition fpRem (e p : nat) (f1 : Float e p) (f2 : Float e p) : Float e p := + match f1, f2 with + | B754_finite _ _ _ _, B754_infinity _ => f1 + | B754_zero _, B754_infinity _ => f1 + | B754_infinity _, _ | B754_nan, _ | _, B754_zero _ | _, B754_nan => B754_nan + + | B754_zero _, B754_finite _ _ _ _ => f1 + | B754_finite _ m1 _ _, B754_finite _ m2 _ _ => + fpFromRational_mode e p mode_NE (fpToRational e p f1 - fpToRational e p f2 * inject_Z (Qround_to_even (fpToRational e p f1 / fpToRational e p f2))) + end. + +Definition fpRound_mode (e p : nat) (rm : mode) (f : Float e p) : Float e p := + match f with + | B754_finite s m e' _ => + fpFromInteger_mode e p rm (fpToInteger_mode e p rm f) + | _ => f + end. + (*** *** A simple typeclass-based implementation of SAW record types *** diff --git a/saw-core-rocq/rocq/handwritten/CryptolToRocq/SAWCoreVectorsAsRocqVectors.v b/saw-core-rocq/rocq/handwritten/CryptolToRocq/SAWCoreVectorsAsRocqVectors.v index d48d942962..b3072199d1 100644 --- a/saw-core-rocq/rocq/handwritten/CryptolToRocq/SAWCoreVectorsAsRocqVectors.v +++ b/saw-core-rocq/rocq/handwritten/CryptolToRocq/SAWCoreVectorsAsRocqVectors.v @@ -26,6 +26,7 @@ From Stdlib Require Import Lists.List. From Stdlib Require Numbers.NatInt.NZLog. From Stdlib Require Import Peano_dec. From Stdlib Require Import PeanoNat. +From Stdlib Require Import QArith.QArith_base. From Stdlib Require Import Strings.String. #[local] Set Warnings "-stdlib-vector". From Stdlib Require Import Vectors.Vector. @@ -39,6 +40,8 @@ From Stdlib Require Import PArith. #[local] Undelimit Scope N_scope. From CryptolToRocq Require Import SAWCoreScaffolding. +From Flocq Require Import IEEE754.BinarySingleNaN. + From mathcomp Require Import ssreflect. #[local] Set Warnings "-notation-overridden". From mathcomp Require Import ssrnat. @@ -47,6 +50,9 @@ From mathcomp Require Import ssrbool. From mathcomp Require Import fintype. From mathcomp Require Import tuple. +(* This defines notations that clash with nat's notations. *) +Close Scope Q_scope. + Import VectorNotations. Definition Vec (n : nat) (a : Type) : Type := VectorDef.t a n. @@ -523,3 +529,94 @@ Definition bvAddOverflow n (a : bitvector n) (b : bitvector n) : bool := Definition bvSubOverflow n (a : bitvector n) (b : bitvector n) : bool := let c := bvSub n a b in ((sign a && ~~ sign b && ~~ sign c) || (~~ sign a && sign b && sign c))%bool. + +(*** + *** Float-related definitions that require bitvectors + ***) + +Definition RoundingMode := bitvector 3. + +Definition fromRoundingMode (rm : RoundingMode) : mode := + match rm with + | (* 0 *) [false; false; false] => mode_NE + | (* 1 *) [false; false; true] => mode_NA + | (* 2 *) [false; true; false] => mode_UP + | (* 3 *) [false; true; true] => mode_DN + | (* 4 *) [true; false; false] => mode_ZR + | _ => mode_NE (* An arbitrary choice *) + end. + +Definition toRoundingMode (rm : mode) : RoundingMode := + match rm with + | mode_NE => (* 0 *) [false; false; false] + | mode_NA => (* 1 *) [false; false; true] + | mode_UP => (* 2 *) [false; true; false] + | mode_DN => (* 3 *) [false; true; true] + | mode_ZR => (* 4 *) [true; false; false] + end. + +(* A simple theorem which ensures we did the mapping from modes to + * RoundingModes correctly. + *) +Theorem fromToRoundingMode : + forall (rm : mode), fromRoundingMode (toRoundingMode rm) = rm. +Proof. +destruct rm; trivial. +Qed. + +Definition fpAdd (e p : nat) (rm : RoundingMode) : Float e p -> Float e p -> Float e p := + fpAdd_mode e p (fromRoundingMode rm). + +Definition fpCast (e1 p1 e2 p2 : nat) (rm : RoundingMode) : Float e1 p1 -> Float e2 p2 := + fpCast_mode e1 p1 e2 p2 (fromRoundingMode rm). + +Definition fpDiv (e p : nat) (rm : RoundingMode) : Float e p -> Float e p -> Float e p := + fpDiv_mode e p (fromRoundingMode rm). + +Definition fpFMA (e p : nat) (rm : RoundingMode) : Float e p -> Float e p -> Float e p -> Float e p := + fpFMA_mode e p (fromRoundingMode rm). + +Definition fpFromBits (e p : nat) (bits : bitvector (addNat e p)) : Float e p := + fpFromBits_Z e p (bvToInt (addNat e p) bits). + +Definition fpFromBV (n e p : nat) (rm : RoundingMode) (bv : bitvector (n.+1)) : Float e p := + fpFromInteger_mode e p (fromRoundingMode rm) (bvToInt (n.+1) bv). + +Definition fpFromInteger (e p : nat) (rm : RoundingMode) : Z -> Float e p := + fpFromInteger_mode e p (fromRoundingMode rm). + +Definition fpFromRational (e p : nat) (rm : RoundingMode) : Q -> Float e p := + fpFromRational_mode e p (fromRoundingMode rm). + +Definition fpFromSBV (n e p : nat) (rm : RoundingMode) (bv : bitvector (n.+1)) : Float e p := + fpFromInteger_mode e p (fromRoundingMode rm) (sbvToInt (n.+1) bv). + +Definition fpMul (e p : nat) (rm : RoundingMode) : Float e p -> Float e p -> Float e p := + fpMul_mode e p (fromRoundingMode rm). + +Definition fpRound (e p : nat) (rm : RoundingMode) : Float e p -> Float e p := + fpRound_mode e p (fromRoundingMode rm). + +Definition fpSqrt (e p : nat) (rm : RoundingMode) : Float e p -> Float e p := + fpSqrt_mode e p (fromRoundingMode rm). + +Definition fpSub (e p : nat) (rm : RoundingMode) : Float e p -> Float e p -> Float e p := + fpSub_mode e p (fromRoundingMode rm). + +Definition fpToBits (e p : nat) (f : Float e p) : bitvector (addNat e p) := + intToBv (addNat e p) (fpToBits_Z e p f). + +Definition fpToInteger (e p : nat) (rm : RoundingMode) : Float e p -> Z := + fpToInteger_mode e p (fromRoundingMode rm). + +(* Note that fpToBV and fpToSBV have the same definition! In SAWCore, these + * definitions will error if you supply a Float whose corresponding bitvector + * lies outside the range of valid unsigned or signed bitvectors. In Rocq, + * these operations will instead return unspecified results. + *) + +Definition fpToBV (e p n : nat) (rm : RoundingMode) (f : Float e p) : bitvector (n.+1) := + intToBv (Succ n) (fpToInteger_mode e p (fromRoundingMode rm) f). + +Definition fpToSBV (e p n : nat) (rm : RoundingMode) (f : Float e p) : bitvector (n.+1) := + intToBv (Succ n) (fpToInteger_mode e p (fromRoundingMode rm) f). diff --git a/saw-core-rocq/src/SAWCoreRocq/SpecialTreatment.hs b/saw-core-rocq/src/SAWCoreRocq/SpecialTreatment.hs index 5159af99e9..d7a0c88b17 100644 --- a/saw-core-rocq/src/SAWCoreRocq/SpecialTreatment.hs +++ b/saw-core-rocq/src/SAWCoreRocq/SpecialTreatment.hs @@ -502,6 +502,46 @@ sawCorePreludeSpecialTreatmentMap configuration = , ("rationalFloor", mapsTo sawDefinitionsModule "rationalFloor") ] + -- Floats + ++ + [ ("Float", mapsTo sawDefinitionsModule "Float") + , ("RoundingMode", mapsTo vectorsModule "RoundingMode") + , ("fpAbs", mapsTo sawDefinitionsModule "fpAbs") + , ("fpAdd", mapsTo vectorsModule "fpAdd") + , ("fpCast", mapsTo vectorsModule "fpCast") + , ("fpDiv", mapsTo vectorsModule "fpDiv") + , ("fpFMA", mapsTo vectorsModule "fpFMA") + , ("fpFromBits", mapsTo vectorsModule "fpFromBits") + , ("fpFromBV", mapsTo vectorsModule "fpFromBV") + , ("fpFromInteger", mapsTo vectorsModule "fpFromInteger") + , ("fpFromRational", mapsTo vectorsModule "fpFromRational") + , ("fpFromSBV", mapsTo vectorsModule "fpFromSBV") + , ("fpIeeeEq", mapsTo sawDefinitionsModule "fpIeeeEq") + , ("fpIsInf", mapsTo sawDefinitionsModule "fpIsInf") + , ("fpIsNaN", mapsTo sawDefinitionsModule "fpIsNaN") + , ("fpIsNeg", mapsTo sawDefinitionsModule "fpIsNeg") + , ("fpIsNormal", mapsTo sawDefinitionsModule "fpIsNormal") + , ("fpIsPos", mapsTo sawDefinitionsModule "fpIsPos") + , ("fpIsSubnormal", mapsTo sawDefinitionsModule "fpIsSubnormal") + , ("fpIsZero", mapsTo sawDefinitionsModule "fpIsZero") + , ("fpLt", mapsTo sawDefinitionsModule "fpLt") + , ("fpLogicalEq", mapsTo sawDefinitionsModule "fpLogicalEq") + , ("fpMul", mapsTo vectorsModule "fpMul") + , ("fpNaN", mapsTo sawDefinitionsModule "fpNaN") + , ("fpNeg", mapsTo sawDefinitionsModule "fpNeg") + , ("fpPosInf", mapsTo sawDefinitionsModule "fpPosInf") + , ("fpPosZero", mapsTo sawDefinitionsModule "fpPosZero") + , ("fpRem", mapsTo sawDefinitionsModule "fpRem") + , ("fpRound", mapsTo vectorsModule "fpRound") + , ("fpSqrt", mapsTo vectorsModule "fpSqrt") + , ("fpSub", mapsTo vectorsModule "fpSub") + , ("fpToBits", mapsTo vectorsModule "fpToBits") + , ("fpToInteger", mapsTo vectorsModule "fpToInteger") + , ("fpToRational", mapsTo sawDefinitionsModule "fpToRational") + , ("fpToBV", mapsTo vectorsModule "fpToBV") + , ("fpToSBV", mapsTo vectorsModule "fpToSBV") + ] + -- Axioms currently skipped ++ [ ("drop0", skip) @@ -519,10 +559,6 @@ sawCorePreludeSpecialTreatmentMap configuration = , ("bvShiftR_bvShr", skip) , ("bvEq_refl", skip) , ("equalNat_bv", skip) - , ("Float", skip) - , ("mkFloat", skip) - , ("Double", skip) - , ("mkDouble", skip) , ("bveq_sameL", skip) , ("bveq_sameR", skip) , ("bveq_same2", skip) diff --git a/saw-core-sbv/src/SAWCoreSBV/SBV.hs b/saw-core-sbv/src/SAWCoreSBV/SBV.hs index 077da97766..01d002ee8d 100644 --- a/saw-core-sbv/src/SAWCoreSBV/SBV.hs +++ b/saw-core-sbv/src/SAWCoreSBV/SBV.hs @@ -2,6 +2,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TupleSections #-} +{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ViewPatterns #-} @@ -41,6 +42,7 @@ module SAWCoreSBV.SBV import Data.SBV.Dynamic import qualified Data.SBV.Dynamic as SBV +import qualified Data.SBV.Float as SBV import qualified Data.SBV.Internals as SBV #if MIN_VERSION_sbv(10,0,0) import Data.SBV.Internals (UICodeKind(..)) @@ -82,7 +84,7 @@ import SAWCore.SharedTerm import SAWCore.Simulator.Value import SAWCore.Term.Functor (FieldName) import SAWCore.FiniteValue - (FirstOrderType(..), FirstOrderValue(..) + (FirstOrderType(..), FirstOrderValue(..), FirstOrderFloat(..) , fovVec, asFirstOrderType ) @@ -94,6 +96,7 @@ type instance EvalM SBV = IO type instance VBool SBV = SBool type instance VWord SBV = SWord type instance VInt SBV = SInteger +type instance VFloat SBV = SFloat type instance Extra SBV = SbvExtra type SValue = Value SBV @@ -131,6 +134,7 @@ prims = , Prims.bpMuxBool = pure3 svIte , Prims.bpMuxWord = pure3 svIte , Prims.bpMuxInt = pure3 svIte + , Prims.bpMuxFloat = pure3 svIte , Prims.bpMuxArray = unsupportedSBVPrimitive "bpMuxArray" , Prims.bpMuxExtra = muxSbvExtra -- Booleans @@ -194,6 +198,41 @@ prims = , Prims.bpIntMin = unsupportedSBVPrimitive "bpIntMin" , Prims.bpIntMax = unsupportedSBVPrimitive "bpIntMax" , Prims.bpNatToInt = pure1 natToInt + -- Float operations + , Prims.bpFpAbs = unsupportedSBVPrimitive "bpFpAbs" + , Prims.bpFpAdd = unsupportedSBVPrimitive "bpFpAdd" + , Prims.bpFpCast = unsupportedSBVPrimitive "bpFpCast" + , Prims.bpFpDiv = unsupportedSBVPrimitive "bpFpDiv" + , Prims.bpFpFMA = unsupportedSBVPrimitive "bpFpFMA" + , Prims.bpFpFromBits = unsupportedSBVPrimitive "bpFpFromBits" + , Prims.bpFpFromBV = unsupportedSBVPrimitive "bpFpFromBV" + , Prims.bpFpFromInteger = unsupportedSBVPrimitive "bpFpFromInteger" + , Prims.bpFpFromRational = unsupportedSBVPrimitive "bpFpFromRational" + , Prims.bpFpFromSBV = unsupportedSBVPrimitive "bpFpFromSBV" + , Prims.bpFpIeeeEq = unsupportedSBVPrimitive "bpFpIeeeEq" + , Prims.bpFpIsInf = unsupportedSBVPrimitive "bpFpIsInf" + , Prims.bpFpIsNaN = unsupportedSBVPrimitive "bpFpIsNaN" + , Prims.bpFpIsNeg = unsupportedSBVPrimitive "bpFpIsNeg" + , Prims.bpFpIsNormal = unsupportedSBVPrimitive "bpFpIsNormal" + , Prims.bpFpIsPos = unsupportedSBVPrimitive "bpFpIsPos" + , Prims.bpFpIsSubnormal = unsupportedSBVPrimitive "bpFpIsSubnormal" + , Prims.bpFpIsZero = unsupportedSBVPrimitive "bpFpIsZero" + , Prims.bpFpLt = unsupportedSBVPrimitive "bpFpLt" + , Prims.bpFpLogicalEq = unsupportedSBVPrimitive "bpFpLogicalEq" + , Prims.bpFpMul = unsupportedSBVPrimitive "bpFpMul" + , Prims.bpFpNaN = unsupportedSBVPrimitive "bpFpNaN" + , Prims.bpFpNeg = unsupportedSBVPrimitive "bpFpNeg" + , Prims.bpFpPosInf = unsupportedSBVPrimitive "bpFpPosInf" + , Prims.bpFpPosZero = unsupportedSBVPrimitive "bpFpPosZero" + , Prims.bpFpRem = unsupportedSBVPrimitive "bpFpRem" + , Prims.bpFpRound = unsupportedSBVPrimitive "bpFpRound" + , Prims.bpFpSqrt = unsupportedSBVPrimitive "bpFpSqrt" + , Prims.bpFpSub = unsupportedSBVPrimitive "bpFpSub" + , Prims.bpFpToBits = unsupportedSBVPrimitive "bpFpToBits" + , Prims.bpFpToBV = unsupportedSBVPrimitive "bpFpToBV" + , Prims.bpFpToInteger = unsupportedSBVPrimitive "bpFpToInteger" + , Prims.bpFpToRational = unsupportedSBVPrimitive "bpFpToRational" + , Prims.bpFpToSBV = unsupportedSBVPrimitive "bpFpToSBV" -- Array operations , Prims.bpArrayConstant = unsupportedSBVPrimitive "bpArrayConstant" , Prims.bpArrayLookup = unsupportedSBVPrimitive "bpArrayLookup" @@ -312,6 +351,9 @@ vBool l = VBool l vInteger :: SInteger -> SValue vInteger x = VInt x +vFloat :: SFloat -> SValue +vFloat l = VFloat l + ------------------------------------------------------------ -- Function constructors @@ -691,6 +733,11 @@ parseUninterpreted cws nm ty = let denom = mkUninterpreted KUnbounded cws (nm ++ ".denom") pure $ VRational numer denom + VFloatType e p + -> do let e' = fromIntegral @Natural @Int e + let p' = fromIntegral @Natural @Int p + return $ vFloat $ mkUninterpreted (KFP e' p') cws nm + (VVecType n VBoolType) -> return $ vWord $ mkUninterpreted (KBounded False (fromIntegral n)) cws nm @@ -772,6 +819,7 @@ data Labeler = BoolLabel String | IntegerLabel String | RationalLabel String String + | FloatLabel String | WordLabel String | ZeroWidthWordLabel | VecLabel @@ -809,6 +857,11 @@ newVars nm fot = let existsSRational = VRational <$> existsSInteger sNumer <*> existsSInteger sDenom pure (RationalLabel sNumer sDenom, existsSRational) + FOTFloat e p -> + do s <- nextId' nm + let e' = fromIntegral @Natural @Int e + let p' = fromIntegral @Natural @Int p + pure (FloatLabel s, vFloat <$> existsSFloat s e' p') FOTVec 0 FOTBit -> pure (ZeroWidthWordLabel, pure (vWord (literalSWord 0 0))) FOTVec n FOTBit -> @@ -850,6 +903,14 @@ getLabels ls d args numer = cvToInteger (d Map.! sNumer) denom = cvToInteger (d Map.! sDenom) + getLabel (FloatLabel s) = FOVFloat $ + FirstOrderFloat + { fofExp = fromIntegral @Int @Natural $ SBV.fpExponentSize fp + , fofPrec = fromIntegral @Int @Natural $ SBV.fpSignificandSize fp + , fofValue = SBV.fpValue fp + } + where fp = cvToFP (d Map.! s) + getLabel (WordLabel s) = FOVWord (cvKind cv) (cvToInteger cv) where cv = d Map.! s @@ -870,6 +931,11 @@ getLabels ls d args CInteger i -> i _ -> error "cvToInteger" + cvToFP cv = + case cvVal cv of + CFP fp -> fp + _ -> error "cvToFP" + ------------------------------------------------------------ -- Code Generation @@ -886,6 +952,11 @@ newCodeGenVars _checkSz FOTRational = do -- TODO(#2433): Assert that the denominator is non-zero. denom <- svCgInput KUnbounded sDenom pure $ VRational numer denom +newCodeGenVars _checkSz (FOTFloat e p) = do + s <- nextId + let e' = fromIntegral @Natural @Int e + let p' = fromIntegral @Natural @Int p + pure (vFloat <$> svCgInput (KFP e' p') s) newCodeGenVars checkSz (FOTVec n FOTBit) | n == 0 = nextId <&> \_ -> return (vWord (literalSWord 0 0)) | checkSz n = nextId <&> \s -> vWord <$> cgInputSWord s (fromIntegral n) diff --git a/saw-core-sbv/src/SAWCoreSBV/SWord.hs b/saw-core-sbv/src/SAWCoreSBV/SWord.hs index 68db1b7644..e60f123e2b 100644 --- a/saw-core-sbv/src/SAWCoreSBV/SWord.hs +++ b/saw-core-sbv/src/SAWCoreSBV/SWord.hs @@ -7,12 +7,13 @@ Stability : experimental Portability : non-portable (language extensions) -} module SAWCoreSBV.SWord - ( SBool, SWord, SInteger + ( SBool, SWord, SInteger, SFloat , literalSWord, literalSInteger , fromBitsLE , forallSWord, existsSWord, forallSWord_, existsSWord_ , forallSBool, existsSBool, forallSBool_, existsSBool_ , forallSInteger, existsSInteger, forallSInteger_, existsSInteger_ + , forallSFloat, existsSFloat, forallSFloat_, existsSFloat_ ) where -- FUTURE: this and the explicit import from Data.Foldable can be @@ -31,6 +32,7 @@ import Data.SBV.Dynamic type SBool = SVal type SWord = SVal type SInteger = SVal +type SFloat = SVal fromBitsLE :: [SBool] -> SWord fromBitsLE bs = foldl' f (literalSWord 0 0) bs @@ -77,3 +79,15 @@ forallSInteger_ = symbolicEnv >>= liftIO . svMkSymVar (NonQueryVar (Just ALL)) K existsSInteger_ :: Symbolic SInteger existsSInteger_ = symbolicEnv >>= liftIO . svMkSymVar (NonQueryVar (Just EX)) KUnbounded Nothing + +forallSFloat :: String -> Int -> Int -> Symbolic SFloat +forallSFloat nm e p = symbolicEnv >>= liftIO . svMkSymVar (NonQueryVar (Just ALL)) (KFP e p) (Just nm) + +existsSFloat :: String -> Int -> Int -> Symbolic SFloat +existsSFloat nm e p = symbolicEnv >>= liftIO . svMkSymVar (NonQueryVar (Just EX)) (KFP e p) (Just nm) + +forallSFloat_ :: Int -> Int -> Symbolic SFloat +forallSFloat_ e p = symbolicEnv >>= liftIO . svMkSymVar (NonQueryVar (Just ALL)) (KFP e p) Nothing + +existsSFloat_ :: Int -> Int -> Symbolic SFloat +existsSFloat_ e p = symbolicEnv >>= liftIO . svMkSymVar (NonQueryVar (Just EX)) (KFP e p) Nothing diff --git a/saw-core-what4/src/SAWCoreWhat4/Common.hs b/saw-core-what4/src/SAWCoreWhat4/Common.hs index bbe8a86f2d..107efe3147 100644 --- a/saw-core-what4/src/SAWCoreWhat4/Common.hs +++ b/saw-core-what4/src/SAWCoreWhat4/Common.hs @@ -44,6 +44,7 @@ import SAWCore.Simulator.Value -- what4 import What4.Interface(Pred,SymInteger,IsSymExprBuilder) import qualified What4.Interface as W +import What4.SFloat (SFloat(..)) import What4.SWord (SWord(..)) -- parameterized-utils @@ -74,6 +75,7 @@ type instance EvalM (What4 sym) = IO type instance VBool (What4 sym) = SBool sym type instance VWord (What4 sym) = SWord sym type instance VInt (What4 sym) = SInt sym +type instance VFloat (What4 sym) = SFloat sym type instance VArray (What4 sym) = SArray sym type instance Extra (What4 sym) = What4Extra sym @@ -110,6 +112,10 @@ termOfTValue sc val = VBoolType -> scBoolType sc VIntType -> scIntegerType sc VRationalType -> scRationalType sc + VFloatType e p -> + do e' <- scNat sc e + p' <- scNat sc p + scFloatType sc e' p' VVecType n a -> do n' <- scNat sc n a' <- termOfTValue sc a diff --git a/saw-core-what4/src/SAWCoreWhat4/FirstOrder.hs b/saw-core-what4/src/SAWCoreWhat4/FirstOrder.hs index 63569ab9db..6160c3fedd 100644 --- a/saw-core-what4/src/SAWCoreWhat4/FirstOrder.hs +++ b/saw-core-what4/src/SAWCoreWhat4/FirstOrder.hs @@ -13,7 +13,9 @@ -- but is also unused in SAWCoreWhat4.What4 ------------------------------------------------------------------------ {-# LANGUAGE CPP #-} +{-# LANGUAGE DataKinds #-} {-# LANGUAGE GADTs #-} +{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE ViewPatterns #-} @@ -33,7 +35,7 @@ import Data.Parameterized.Context hiding (replicate) import SAWCoreWhat4.PosNat -import SAWCore.FiniteValue (FirstOrderType(..),FirstOrderValue(..)) +import SAWCore.FiniteValue (FirstOrderType(..),FirstOrderValue(..),FirstOrderFloat(..)) import What4.BaseTypes import What4.IndexLit @@ -53,6 +55,13 @@ fotToBaseType (FOTVec nat FOTBit) | Just (Some (PosNat nr)) <- somePosNat nat = Just (Some (BaseBVRepr nr)) | otherwise = Nothing +fotToBaseType (FOTFloat e p) + | Just (Some e') <- someNat e + , Just (Some p') <- someNat p + , Just LeqProof <- testLeq (knownNat @2) e' + , Just LeqProof <- testLeq (knownNat @2) p' + = Just (Some (BaseFloatRepr (FloatingPointPrecisionRepr e' p'))) + | otherwise = Nothing fotToBaseType (FOTVec nat fot) | Just (Some assn) <- listToAssn (replicate (fromIntegral nat) fot) @@ -82,6 +91,8 @@ typeReprToFOT :: BaseTypeRepr ty -> Either String FirstOrderType typeReprToFOT BaseBoolRepr = pure FOTBit typeReprToFOT BaseIntegerRepr = pure FOTInt typeReprToFOT (BaseBVRepr w) = pure $ FOTVec (natValue w) FOTBit +typeReprToFOT (BaseFloatRepr (FloatingPointPrecisionRepr e p)) + = pure $ FOTFloat (natValue e) (natValue p) typeReprToFOT BaseRealRepr = Left "No FO Real" typeReprToFOT BaseComplexRepr = Left "No FO Complex" typeReprToFOT (BaseStringRepr _) = Left "No FO String" @@ -90,7 +101,6 @@ typeReprToFOT (BaseArrayRepr (Empty :> ty) b) , Right fot2 <- typeReprToFOT b = pure $ FOTArray fot1 fot2 typeReprToFOT ty@(BaseArrayRepr _ctx _b) = Left $ "Unsupported FO Array: " ++ show ty -typeReprToFOT (BaseFloatRepr _) = Left "No FO Floating point" typeReprToFOT (BaseStructRepr ctx) = FOTTuple <$> assnToList ctx assnToList :: Assignment BaseTypeRepr ctx -> Either String [FirstOrderType] @@ -106,10 +116,15 @@ groundToFOV :: BaseTypeRepr ty -> GroundValue ty -> Either String FirstOrderValu groundToFOV BaseBoolRepr b = pure $ FOVBit b groundToFOV BaseIntegerRepr i = pure $ FOVInt i groundToFOV (BaseBVRepr w) bv = pure $ FOVWord (natValue w) (BV.asUnsigned bv) +groundToFOV (BaseFloatRepr (FloatingPointPrecisionRepr e p)) f + = pure $ FOVFloat $ FirstOrderFloat + { fofExp = natValue e + , fofPrec = natValue p + , fofValue = f + } groundToFOV BaseRealRepr _ = Left "Real is not FOV" groundToFOV BaseComplexRepr _ = Left "Complex is not FOV" groundToFOV (BaseStringRepr _) _ = Left "String is not FOV" -groundToFOV (BaseFloatRepr _) _ = Left "Floating point is not FOV" groundToFOV (BaseArrayRepr (Empty :> ty_idx) ty_val) (ArrayMapping _) = do -- ArrayMapping is an array represented as a function call we can -- use to extract values. We can't do anything useful with this diff --git a/saw-core-what4/src/SAWCoreWhat4/ReturnTrip.hs b/saw-core-what4/src/SAWCoreWhat4/ReturnTrip.hs index 89a3ea0d9d..6d1cbef1b3 100644 --- a/saw-core-what4/src/SAWCoreWhat4/ReturnTrip.hs +++ b/saw-core-what4/src/SAWCoreWhat4/ReturnTrip.hs @@ -190,6 +190,10 @@ baseSCType sym sc bt = BaseBoolRepr -> SC.scBoolType sc BaseBVRepr w -> SC.scBitvector sc $ fromIntegral (natValue w) BaseIntegerRepr -> SC.scIntegerType sc + BaseFloatRepr (FloatingPointPrecisionRepr e p) -> + do e' <- SC.scNat sc (natValue e) + p' <- SC.scNat sc (natValue p) + SC.scFloatType sc e' p' BaseArrayRepr indexTypes range | Ctx.Empty Ctx.:> idx_type <- indexTypes -> do sc_idx_type <- baseSCType sym sc idx_type @@ -197,8 +201,6 @@ baseSCType sym sc bt = SC.scArrayType sc sc_idx_type sc_elm_type | otherwise -> unsupported sym "SAW backend does not support multidimensional Arrays: baseSCType" - BaseFloatRepr _ -> - unsupported sym "SAW backend does not support IEEE-754 floating point values: baseSCType" BaseStringRepr _ -> unsupported sym "SAW backend does not support string values: baseSCType" BaseComplexRepr -> @@ -445,6 +447,11 @@ scEq sym sc tp x y = let SAWExpr y' = y w' <- SC.scNat sc $ fromIntegral (natValue w) SAWExpr <$> SC.scBvEq sc w' x' y' + BaseFloatRepr fpp -> + do let SAWExpr x' = x + let SAWExpr y' = y + (e', p') <- scFloatPrecisionRepr sc fpp + SAWExpr <$> SC.scFpLogicalEq sc e' p' x' y' _ -> unsupported sym ("SAW backend: equality comparison on unsupported type:" ++ show tp) @@ -514,6 +521,29 @@ scBvXor sc w (SAWExpr x) (SAWExpr y) = do n <- SC.scNat sc (natValue w) SAWExpr <$> SC.scBvXor sc n x y +-- | Convert the number of exponent and precision (significand) bits in a +-- 'FloatPrecisionRepr' to 'SC.Term's. +scFloatPrecisionRepr :: + SC.SharedContext -> + FloatPrecisionRepr fpp -> + IO (SC.Term, SC.Term) +scFloatPrecisionRepr sc (FloatingPointPrecisionRepr e p) = + do e' <- SC.scNat sc (natValue e) + p' <- SC.scNat sc (natValue p) + pure (e', p') + +scRoundingMode :: + SC.SharedContext -> + RoundingMode -> + IO SC.Term +scRoundingMode sc rm = + case rm of + RNE -> SC.scRoundNearestEven sc + RNA -> SC.scRoundNearestAway sc + RTP -> SC.scRoundPositive sc + RTN -> SC.scRoundNegative sc + RTZ -> SC.scRoundZero sc + termOfSAWExpr :: sym -> SC.SharedContext -> @@ -592,9 +622,6 @@ evaluateExpr sym st sc cache = f Map.empty cplxFail :: IO a cplxFail = unsupported sym "SAW backend does not support complex values" - floatFail :: IO a - floatFail = unsupported sym "SAW backend does not support floating-point values" - stringFail :: IO a stringFail = unsupported sym "SAW backend does not support string values" @@ -614,8 +641,9 @@ evaluateExpr sym st sc cache = f Map.empty go _ (B.StringExpr{}) = unsupported sym "SAW backend does not support string values" - go _ (B.FloatExpr{}) = - unsupported sym "SAW backend does not support floating-point values" + go _ (B.FloatExpr fpp bf _) = + do (e', p') <- scFloatPrecisionRepr sc fpp + SAWExpr <$> SC.scFloat sc e' p' bf go env (B.BoundVarExpr bv) = case B.bvarKind bv of @@ -858,7 +886,7 @@ evaluateExpr sym st sc cache = f Map.empty sc_elm <- f env v SAWExpr <$> SC.scArrayConstant sc sc_idx_type sc_elm_type sc_elm | otherwise -> unimplemented "multidimensional ConstantArray" - + B.SelectArray range arr indexTerms | Ctx.Empty Ctx.:> idx <- indexTerms , idx_type <- exprType idx -> @@ -968,36 +996,154 @@ evaluateExpr sym st sc cache = f Map.empty ------------------------------------------------------------------------ -- Floating point operations - B.FloatNeg{} -> floatFail - B.FloatAbs{} -> floatFail - B.FloatSqrt{} -> floatFail - B.FloatAdd{} -> floatFail - B.FloatSub{} -> floatFail - B.FloatMul{} -> floatFail - B.FloatDiv{} -> floatFail - B.FloatRem{} -> floatFail - B.FloatFMA{} -> floatFail - B.FloatFpEq{} -> floatFail - B.FloatLe{} -> floatFail - B.FloatLt{} -> floatFail - B.FloatIsNaN{} -> floatFail - B.FloatIsInf{} -> floatFail - B.FloatIsZero{} -> floatFail - B.FloatIsPos{} -> floatFail - B.FloatIsNeg{} -> floatFail - B.FloatIsSubnorm{} -> floatFail - B.FloatIsNorm{} -> floatFail - B.FloatCast{} -> floatFail - B.FloatRound{} -> floatFail - B.FloatFromBinary{} -> floatFail - B.BVToFloat{} -> floatFail - B.SBVToFloat{} -> floatFail - B.RealToFloat{} -> floatFail - B.FloatToBV{} -> floatFail - B.FloatToSBV{} -> floatFail - B.FloatToReal{} -> floatFail - B.FloatToBinary{} -> floatFail - B.FloatSpecialFunction{} -> floatFail + B.FloatNeg fpp x -> + do (e', p') <- scFloatPrecisionRepr sc fpp + x' <- f env x + SAWExpr <$> SC.scFpNeg sc e' p' x' + B.FloatAbs fpp x -> + do (e', p') <- scFloatPrecisionRepr sc fpp + x' <- f env x + SAWExpr <$> SC.scFpAbs sc e' p' x' + B.FloatSqrt fpp m x -> + do (e', p') <- scFloatPrecisionRepr sc fpp + m' <- scRoundingMode sc m + x' <- f env x + SAWExpr <$> SC.scFpSqrt sc e' p' m' x' + B.FloatAdd fpp m x y -> + do (e', p') <- scFloatPrecisionRepr sc fpp + m' <- scRoundingMode sc m + x' <- f env x + y' <- f env y + SAWExpr <$> SC.scFpAdd sc e' p' m' x' y' + B.FloatSub fpp m x y -> + do (e', p') <- scFloatPrecisionRepr sc fpp + m' <- scRoundingMode sc m + x' <- f env x + y' <- f env y + SAWExpr <$> SC.scFpSub sc e' p' m' x' y' + B.FloatMul fpp m x y -> + do (e', p') <- scFloatPrecisionRepr sc fpp + m' <- scRoundingMode sc m + x' <- f env x + y' <- f env y + SAWExpr <$> SC.scFpMul sc e' p' m' x' y' + B.FloatDiv fpp m x y -> + do (e', p') <- scFloatPrecisionRepr sc fpp + m' <- scRoundingMode sc m + x' <- f env x + y' <- f env y + SAWExpr <$> SC.scFpDiv sc e' p' m' x' y' + B.FloatRem fpp x y -> + do (e', p') <- scFloatPrecisionRepr sc fpp + x' <- f env x + y' <- f env y + SAWExpr <$> SC.scFpRem sc e' p' x' y' + B.FloatFMA fpp m x y z -> + do (e', p') <- scFloatPrecisionRepr sc fpp + m' <- scRoundingMode sc m + x' <- f env x + y' <- f env y + z' <- f env z + SAWExpr <$> SC.scFpFMA sc e' p' m' x' y' z' + B.FloatFpEq x y -> + do (e', p') <- scFloatPrecisionRepr sc (floatPrecision x) + x' <- f env x + y' <- f env y + SAWExpr <$> SC.scFpIeeeEq sc e' p' x' y' + B.FloatLe x y -> + do (e', p') <- scFloatPrecisionRepr sc (floatPrecision x) + x' <- f env x + y' <- f env y + SAWExpr <$> SC.scFpLe sc e' p' x' y' + B.FloatLt x y -> + do (e', p') <- scFloatPrecisionRepr sc (floatPrecision x) + x' <- f env x + y' <- f env y + SAWExpr <$> SC.scFpLt sc e' p' x' y' + B.FloatIsNaN x -> + do (e', p') <- scFloatPrecisionRepr sc (floatPrecision x) + x' <- f env x + SAWExpr <$> SC.scFpIsNaN sc e' p' x' + B.FloatIsInf x -> + do (e', p') <- scFloatPrecisionRepr sc (floatPrecision x) + x' <- f env x + SAWExpr <$> SC.scFpIsInf sc e' p' x' + B.FloatIsZero x -> + do (e', p') <- scFloatPrecisionRepr sc (floatPrecision x) + x' <- f env x + SAWExpr <$> SC.scFpIsZero sc e' p' x' + B.FloatIsPos x -> + do (e', p') <- scFloatPrecisionRepr sc (floatPrecision x) + x' <- f env x + SAWExpr <$> SC.scFpIsPos sc e' p' x' + B.FloatIsNeg x -> + do (e', p') <- scFloatPrecisionRepr sc (floatPrecision x) + x' <- f env x + SAWExpr <$> SC.scFpIsNeg sc e' p' x' + B.FloatIsSubnorm x -> + do (e', p') <- scFloatPrecisionRepr sc (floatPrecision x) + x' <- f env x + SAWExpr <$> SC.scFpIsSubnormal sc e' p' x' + B.FloatIsNorm x -> + do (e', p') <- scFloatPrecisionRepr sc (floatPrecision x) + x' <- f env x + SAWExpr <$> SC.scFpIsNormal sc e' p' x' + B.FloatCast fpp m x -> + do (e1', p1') <- scFloatPrecisionRepr sc (floatPrecision x) + (e2', p2') <- scFloatPrecisionRepr sc fpp + m' <- scRoundingMode sc m + x' <- f env x + SAWExpr <$> SC.scFpCast sc e1' p1' e2' p2' m' x' + B.FloatRound fpp m x -> + do (e', p') <- scFloatPrecisionRepr sc fpp + m' <- scRoundingMode sc m + x' <- f env x + SAWExpr <$> SC.scFpRound sc e' p' m' x' + B.BVToFloat fpp m x -> + do -- NB: fpFromBV applies 'Succ' to its bitvector width argument, so + -- we need to subtract 1 to make the types match. + BaseBVRepr n <- pure (exprType x) + (e', p') <- scFloatPrecisionRepr sc fpp + n' <- SC.scNat sc (natValue n - 1) + m' <- scRoundingMode sc m + x' <- f env x + SAWExpr <$> SC.scFpFromBV sc n' e' p' m' x' + B.SBVToFloat fpp m x -> + do -- NB: fpFromSBV applies 'Succ' to its bitvector width argument, + -- so we need to subtract 1 to make the types match. + BaseBVRepr n <- pure (exprType x) + n' <- SC.scNat sc (natValue n - 1) + (e', p') <- scFloatPrecisionRepr sc fpp + m' <- scRoundingMode sc m + x' <- f env x + SAWExpr <$> SC.scFpFromSBV sc n' e' p' m' x' + B.FloatToBV n m x -> + do -- NB: fpToBV applies 'Succ' to its bitvector width argument, so + -- we need to subtract 1 to make the types match. + n' <- SC.scNat sc (natValue n - 1) + (e', p') <- scFloatPrecisionRepr sc (floatPrecision x) + m' <- scRoundingMode sc m + x' <- f env x + SAWExpr <$> SC.scFpToBV sc n' e' p' m' x' + B.FloatToSBV n m x -> + do -- NB: fpToSBV applies 'Succ' to its bitvector width argument, so + -- we need to subtract 1 to make the types match. + n' <- SC.scNat sc (natValue n) + (e', p') <- scFloatPrecisionRepr sc (floatPrecision x) + m' <- scRoundingMode sc m + x' <- f env x + SAWExpr <$> SC.scFpToSBV sc n' e' p' m' x' + B.FloatFromBinary fpp x -> + do (e', p') <- scFloatPrecisionRepr sc fpp + x' <- f env x + SAWExpr <$> SC.scFpFromBits sc e' p' x' + B.FloatToBinary fpp x -> + do (e', p') <- scFloatPrecisionRepr sc fpp + x' <- f env x + SAWExpr <$> SC.scFpToBits sc e' p' x' + B.FloatToReal{} -> realFail + B.RealToFloat{} -> realFail + B.FloatSpecialFunction{} -> unimplemented "FloatSpecialFunction" B.RoundReal{} -> realFail B.RoundEvenReal{} -> realFail diff --git a/saw-core-what4/src/SAWCoreWhat4/Uninterp.hs b/saw-core-what4/src/SAWCoreWhat4/Uninterp.hs index 7fc478942f..8616dc1962 100644 --- a/saw-core-what4/src/SAWCoreWhat4/Uninterp.hs +++ b/saw-core-what4/src/SAWCoreWhat4/Uninterp.hs @@ -163,6 +163,7 @@ import qualified What4.Expr.Builder as B import What4.Interface(SymExpr,SymFnWrapper(..),IsSymExprBuilder) import qualified What4.Interface as W import What4.BaseTypes +import What4.SFloat (SFloat(..)) import What4.SWord (SWord(..)) -- parameterized-utils @@ -313,6 +314,13 @@ countUninterpreted scale count ty = VIntType -> add BaseIntegerRepr count VIntModType {} -> add BaseIntegerRepr count VRationalType -> add BaseIntegerRepr (add BaseIntegerRepr count) + VFloatType e p -> + case (someNat e, someNat p) of + (Just (Some e'), Just (Some p')) + | Just LeqProof <- testLeq (knownNat @2) e' + , Just LeqProof <- testLeq (knownNat @2) p' -> + add (BaseFloatRepr (FloatingPointPrecisionRepr e' p')) count + _ -> count VVecType n VBoolType -> case somePosNat n of Just (Some (PosNat w)) -> add (BaseBVRepr w) count @@ -468,6 +476,14 @@ parseUninterpreted' saw ref app ty = denom <- mkUninterpreted BaseIntegerRepr (mapArgTerm (\_ -> bad) saw) pure $ VRational numer denom + VFloatType e p + | Just (Some e') <- someNat e + , Just (Some p') <- someNat p + , Just LeqProof <- testLeq (knownNat @2) e' + , Just LeqProof <- testLeq (knownNat @2) p' + -> (VFloat . SFloat) <$> + mkUninterpreted (BaseFloatRepr (FloatingPointPrecisionRepr e' p')) saw + VVecType n VBoolType -> case somePosNat n of Just (Some (PosNat w)) -> VWord . DBV <$> mkUninterpreted (BaseBVRepr w) saw @@ -592,6 +608,7 @@ applyUnintApp sym app0 v = VRational numer denom -> do app1 <- applyUnintApp sym app0 (VInt numer) app2 <- applyUnintApp sym app1 (VInt denom) pure app2 + VFloat (SFloat sf) -> return (extendUnintApp app0 sf (W.exprType sf)) VWord (DBV sw) -> return (extendUnintApp app0 sw (W.exprType sw)) VArray (SArray sa) -> return (extendUnintApp app0 sa (W.exprType sa)) VWord ZBV -> return app0 @@ -755,6 +772,7 @@ mkArgTerm sc ty val = (VIntType, VInt _) -> return ArgTermVar (_, VWord ZBV) -> return ArgTermBVZero -- 0-width bitvector is a constant (_, VWord (DBV _)) -> return ArgTermVar + (_, VFloat{}) -> return ArgTermVar (_, VArray{}) -> return ArgTermVar (VIntModType n, VIntMod _ _) -> pure (ArgTermToIntMod n ArgTermVar) (VRationalType, VRational numer denom) -> diff --git a/saw-core-what4/src/SAWCoreWhat4/What4.hs b/saw-core-what4/src/SAWCoreWhat4/What4.hs index b223e73300..8a583bee27 100644 --- a/saw-core-what4/src/SAWCoreWhat4/What4.hs +++ b/saw-core-what4/src/SAWCoreWhat4/What4.hs @@ -85,6 +85,8 @@ import What4.Interface(SymExpr,Pred,SymInteger, IsExpr, IsExprBuilder,IsSymExprBuilder, BoundVar) import qualified What4.Interface as W import What4.BaseTypes +import qualified What4.SFloat as SF +import What4.SFloat (SFloat(..)) import qualified What4.SWord as SW import What4.SWord (SWord(..)) @@ -123,6 +125,7 @@ prims sym = , Prims.bpMuxBool = W.itePred sym , Prims.bpMuxWord = SW.bvIte sym , Prims.bpMuxInt = W.intIte sym + , Prims.bpMuxFloat = SF.fpIte sym , Prims.bpMuxArray = arrayIte sym , Prims.bpMuxExtra = muxWhat4Extra sym -- Booleans @@ -186,6 +189,92 @@ prims sym = , Prims.bpIntMin = intMin sym , Prims.bpIntMax = intMax sym , Prims.bpNatToInt = natToInt sym + -- Float operations + , Prims.bpFpAbs = SF.fpAbs sym + , Prims.bpFpAdd = fpBinArith SF.fpAdd sym + , Prims.bpFpCast = \e p r x -> do + rm <- fpRoundingMode sym r + SF.fpCast sym (toInteger @Natural e) (toInteger @Natural p) rm x + , Prims.bpFpDiv = fpBinArith SF.fpDiv sym + , Prims.bpFpFMA = \r x y z -> do + rm <- fpRoundingMode sym r + SF.fpFMA sym rm x y z + , Prims.bpFpFromBits = \e p -> + SF.fpFromBinary sym (toInteger @Natural e) (toInteger @Natural p) + , Prims.bpFpFromBV = \e p r x -> do + rm <- fpRoundingMode sym r + SF.fpFromBV sym (toInteger @Natural e) (toInteger @Natural p) rm x + , Prims.bpFpFromInteger = \e p r x -> do + rm <- fpRoundingMode sym r + SF.fpFromInteger sym (toInteger @Natural e) (toInteger @Natural p) rm x + , Prims.bpFpFromRational = \e p r numer denom -> do + rm <- fpRoundingMode sym r + SF.fpFromRational sym (toInteger @Natural e) (toInteger @Natural p) rm numer denom + , Prims.bpFpFromSBV = \e p r x -> do + rm <- fpRoundingMode sym r + SF.fpFromSBV sym (toInteger @Natural e) (toInteger @Natural p) rm x + , Prims.bpFpIeeeEq = SF.fpEqIEEE sym + , Prims.bpFpIsInf = SF.fpIsInf sym + , Prims.bpFpIsNaN = SF.fpIsNaN sym + , Prims.bpFpIsNeg = SF.fpIsNeg sym + , Prims.bpFpIsNormal = SF.fpIsNorm sym + , Prims.bpFpIsPos = SF.fpIsPos sym + , Prims.bpFpIsSubnormal = SF.fpIsSubnorm sym + , Prims.bpFpIsZero = SF.fpIsZero sym + , Prims.bpFpLt = SF.fpLtIEEE sym + , Prims.bpFpLogicalEq = SF.fpEq sym + , Prims.bpFpMul = fpBinArith SF.fpMul sym + , Prims.bpFpNaN = \e p -> + SF.fpNaN sym (toInteger @Natural e) (toInteger @Natural p) + , Prims.bpFpNeg = SF.fpNeg sym + , Prims.bpFpPosInf = \e p -> + SF.fpPosInf sym (toInteger @Natural e) (toInteger @Natural p) + , Prims.bpFpPosZero = \e p -> + SF.fpPosZero sym (toInteger @Natural e) (toInteger @Natural p) + , Prims.bpFpRem = SF.fpRem sym + , Prims.bpFpRound = \r x -> do + rm <- fpRoundingMode sym r + SF.fpRound sym rm x + , Prims.bpFpSqrt = \r x -> do + rm <- fpRoundingMode sym r + SF.fpSqrt sym rm x + , Prims.bpFpSub = fpBinArith SF.fpSub sym + , Prims.bpFpToBits = SF.fpToBinary sym + -- The implementations of bpFpToBV, bpFpToInteger, bpFpToRational, and + -- bpFpToSBV below are all incomplete. Each operation has inputs that it + -- *should* error out on, but they currently do not due to + -- https://github.com/GaloisInc/saw-script/issues/2433. + , Prims.bpFpToBV = \w r x -> do + -- This implementation ought to be rejecting float arguments that are out + -- of the range of valid unsigned bitvectors, but this currently does not + -- happen. + rm <- fpRoundingMode sym r + SF.fpToBV sym w rm x + , Prims.bpFpToInteger = \r x -> do + -- Inspired by Cryptol.Backend.What4.fpCvtToInteger. This implementation + -- ought to be rejecting infinite or NaN arguments, but this currently + -- does not happen. + rm <- fpRoundingMode sym r + y <- SF.fpToReal sym x + case rm of + W.RNE -> W.realRoundEven sym y + W.RNA -> W.realRound sym y + W.RTP -> W.realCeil sym y + W.RTN -> W.realFloor sym y + W.RTZ -> W.realTrunc sym y + , Prims.bpFpToRational = \x -> do + -- Inspired by Cryptol.Backend.What4.fpCvtToRational. This implementation + -- ought to be rejecting infinite or NaN arguments, but this currently + -- does not happen (as evidenced by the fact that we ignore the `_rel` + -- safety predicate below). + (_rel,numer,denom) <- SF.fpToRational sym x + pure (numer, denom) + , Prims.bpFpToSBV = \w r x -> do + -- This implementation ought to be rejecting float arguments that are out + -- of the range of valid signed bitvectors, but this currently does not + -- happen. + rm <- fpRoundingMode sym r + SF.fpToSBV sym w rm x -- Array operations , Prims.bpArrayConstant = arrayConstant sym , Prims.bpArrayLookup = arrayLookup sym @@ -284,6 +373,7 @@ symExprToValue tp expr = case tp of BaseIntegerRepr -> Just $ VInt expr (BaseBVRepr w) -> Just $ withKnownNat w $ VWord $ DBV expr (BaseArrayRepr (Ctx.Empty Ctx.:> _) _) -> Just $ VArray $ SArray expr + (BaseFloatRepr _) -> Just $ VFloat $ SFloat expr _ -> Nothing -- @@ -625,6 +715,32 @@ selectV sym merger maxValue valueFn vx = p <- SW.bvAtLE sym vx (toInteger j) merger p (impl j (y `setBit` j)) (impl j y) where j = i - 1 +fpRoundingMode :: + W.IsSymExprBuilder sym => sym -> SWord sym -> IO W.RoundingMode +fpRoundingMode _sym v = + case SW.bvAsUnsignedInteger v of + Just i -> + case i of + 0 -> pure W.RNE + 1 -> pure W.RNA + 2 -> pure W.RTP + 3 -> pure W.RTN + 4 -> pure W.RTZ + _ -> error $ "Invalid rounding mode: " ++ show i + Nothing -> error "Symbolic rounding modes not supported" + +fpBinArith :: + W.IsSymExprBuilder sym => + SF.SFloatBinArith sym -> + sym -> + SWord sym -> + SFloat sym -> + SFloat sym -> + IO (SFloat sym) +fpBinArith fun = \sym r x y -> + do rm <- fpRoundingMode sym r + fun sym rm x y + arrayConstant :: W.IsSymExprBuilder sym => sym -> @@ -958,6 +1074,16 @@ boundFOTs sym vars = -- TODO(#2433): Assert that the denominator is non-zero. denom <- freshBnd x BaseIntegerRepr pure $ VRational numer denom + FOTFloat e p -> + case (someNat e, someNat p) of + (Just (Some e'), Just (Some p')) + | Just LeqProof <- testLeq (knownNat @2) e' + , Just LeqProof <- testLeq (knownNat @2) p' -> + VFloat . SFloat <$> + freshBnd x (BaseFloatRepr (FloatingPointPrecisionRepr e' p')) + _ -> fail $ + "boundFOTs: float type with unsupported exponent size " ++ + "(" ++ show e ++ ") or precision size (" ++ show p ++ ")" FOTVec n FOTBit -> case somePosNat n of @@ -1242,6 +1368,8 @@ rebuildTerm sym st sc tv sv = chokeOn "VIntToNat" VRational{} -> chokeOn "VRational" + VFloat (SFloat f) -> + toSC sym st f VNat n -> scNat sc n VInt x -> @@ -1353,4 +1481,3 @@ w4EvalBasic sym st sc m addlPrims varCons ref unintSet t = Sim.evalGlobal' m (constMap sym `Map.union` addlPrims) variable' uninterpreted (recursor sym) primHandler mux Sim.evalSharedTerm cfg t - diff --git a/saw-core/prelude/Prelude.sawcore b/saw-core/prelude/Prelude.sawcore index 2054ad3ac9..39fb45975d 100644 --- a/saw-core/prelude/Prelude.sawcore +++ b/saw-core/prelude/Prelude.sawcore @@ -2146,25 +2146,6 @@ updBvFun : (n:Nat) -> (a:sort 0) -> (Vec n Bool -> a) -> Vec n Bool -> a -> (Vec n Bool -> a); updBvFun n a f i v x = ite a (bvEq n i x) v (f x); --------------------------------------------------------------------------------- --- Floating-point values --- Currently commented out because they are not implemented... - -primitive Float : sort 0; - --- mkFloat m e = m * 2^^e -primitive mkFloat : Integer -> Integer -> Float; --- primitive bvToFloat : Vec 32 Bool -> Float; --- primitive floatToBV : Float -> Vec 32 Bool; - -primitive Double : sort 0; - --- mkDouble m e = m * 2^^e -primitive mkDouble : Integer -> Integer -> Float; --- primitive bvToDouble : Vec 64 Bool -> Double; --- primitive doubleToBV : Double -> Vec 64 Bool; - - -------------------------------------------------------------------------------- -- Lists @@ -2589,6 +2570,184 @@ rationalRoundToEven r = lo hi)); +-------------------------------------------------------------------------------- +-- Floating point + +-- | An IEEE-754 floating-point value, where the first Nat encodes the number +-- of exponent bits, and the second Nat encodes the number of significand +-- (precision) bits. +-- +-- Note that while Float accepts any number of bits, in practice, various +-- floating-point libraries require the numbers of bits to be above certain +-- minimum values. See Note [Minimum number of Float bits]. +primitive Float : Nat -> Nat -> sort 0; + +-- Note [Minimum number of Float bits] +-- +-- While the Float type accepts any number of bits, the various floating-point +-- libraries that SAWCore interfaces with do not: +-- +-- * LibBF requires at least 3 exponent bits +-- (https://github.com/GaloisInc/libBF-hs/blob/9952c4d3c15abe40e11df3b39a55a0224b4e8ae8/libbf-quickjs-2021-03-27/libbf.h#L64-L65) +-- and at least 2 significand bits +-- (https://github.com/GaloisInc/libBF-hs/blob/9952c4d3c15abe40e11df3b39a55a0224b4e8ae8/libbf-quickjs-2021-03-27/libbf.h#L70-L71). +-- +-- * SMT-LIB requires at least 2 exponent and significand bits. Per the SMT-LIB +-- FloatingPoint theory (https://smt-lib.org/theories-FloatingPoint.shtml), +-- "All nullary sort symbols of the form +-- +-- (_ FloatingPoint eb sb), +-- +-- where eb and sb are numerals greater than 1." +-- +-- The what4 library also encodes these constraints into the definition of +-- FloatPrecisionRepr +-- (https://github.com/GaloisInc/what4/blob/905ff37a92b193a142f833b85429b50b5510bb46/what4/src/What4/BaseTypes.hs#L197). +-- +-- * Flocq requires at least 2 exponent bits +-- (https://gitlab.inria.fr/flocq/flocq/-/blob/27143972fc1dc96e281626d5194b5b371f05db80/src/IEEE754/BinarySingleNaN.v#L43) +-- and at least 1 significand bit +-- (https://gitlab.inria.fr/flocq/flocq/-/blob/27143972fc1dc96e281626d5194b5b371f05db80/src/IEEE754/BinarySingleNaN.v#L42). +-- +-- What should we do at the SAWCore level? One approach would be to encode the +-- minimum number of bits into the types of all floating-point operations. For +-- instance, we could require a minimum of 3 exponent bits and 2 significand +-- bits in the type of fpPosZero like so: +-- +-- primitive fpPosZero : (e : Nat) -> (p : Nat) -> Float (addNat e 3) (addNat p 2); +-- +-- We ultimately rejected this idea, as it would require adding or subtracting +-- the minimum number of bits in many different parts of the code, and this +-- imposes a non-trivial amount of additional bookkeeping. +-- +-- Instead, we allow floating-point operations to take whatever number of bits +-- they like. If a user supplies an insufficient number of bits, then the +-- backend library (e.g., LibBF or what4) will raise an error. We expect this +-- corner case to be rare, as most users will be using a pre-baked +-- floating-point configuration like Float16, Float32, Float64, etc., all of +-- which meet the minimum bit requirements. +-- +-- One final wrinkle in this story is how to translate Cryptol's ValidFloat +-- constraint (which encodes the minimum number of bits at the type level) with +-- cryptol-saw-core. cryptol-saw-core currently discards such constraints +-- during translation, but after +-- https://github.com/GaloisInc/saw-script/pull/3202 lands, we may want to +-- revisit this. + +-- How to round a IEEE-754 floating-point value. We adopt Cryptol's convention +-- of representing RoundingModes as 3-bit words. +RoundingMode : sort 0; +RoundingMode = Vec 3 Bool; + +roundNearestEven : RoundingMode; +roundNearestEven = bvNat 3 0; + +roundNearestAway : RoundingMode; +roundNearestAway = bvNat 3 1; + +roundPositive : RoundingMode; +roundPositive = bvNat 3 2; + +roundNegative : RoundingMode; +roundNegative = bvNat 3 3; + +roundZero : RoundingMode; +roundZero = bvNat 3 4; + +rne : RoundingMode; +rne = roundNearestEven; + +rna : RoundingMode; +rna = roundNearestAway; + +rtp : RoundingMode; +rtp = roundPositive; + +rtn : RoundingMode; +rtn = roundNegative; + +rtz : RoundingMode; +rtz = roundZero; + +----- Floating-point primitives from Cryptol's Float.cry + +primitive fpNaN : (e : Nat) -> (p : Nat) -> Float e p; +primitive fpPosInf : (e : Nat) -> (p : Nat) -> Float e p; +primitive fpFromBits : (e : Nat) -> (p : Nat) -> Vec (addNat e p) Bool -> Float e p; +primitive fpToBits : (e : Nat) -> (p : Nat) -> Float e p -> Vec (addNat e p) Bool; + +-- | fpLogicalEq is the equivalent of Cryptol's (=.=) function. That is, it +-- checks if two floating-point values are representationally the same. +-- According to fpLogicalEq, fpNaN is equal to itself, and fpPosZero is not +-- equal to fpNegZero. (Contrast this with fpIeeeEq, which checks if two +-- floating-point values are equal according to IEEE-754's notion of equality.) +primitive fpLogicalEq : (e : Nat) -> (p : Nat) -> Float e p -> Float e p -> Bool; + +primitive fpIsNaN : (e : Nat) -> (p : Nat) -> Float e p -> Bool; +primitive fpIsInf : (e : Nat) -> (p : Nat) -> Float e p -> Bool; +primitive fpIsZero : (e : Nat) -> (p : Nat) -> Float e p -> Bool; +primitive fpIsNeg : (e : Nat) -> (p : Nat) -> Float e p -> Bool; +primitive fpIsNormal : (e : Nat) -> (p : Nat) -> Float e p -> Bool; +primitive fpIsSubnormal : (e : Nat) -> (p : Nat) -> Float e p -> Bool; +primitive fpAdd : (e : Nat) -> (p : Nat) -> RoundingMode -> Float e p -> Float e p -> Float e p; +primitive fpSub : (e : Nat) -> (p : Nat) -> RoundingMode -> Float e p -> Float e p -> Float e p; +primitive fpMul : (e : Nat) -> (p : Nat) -> RoundingMode -> Float e p -> Float e p -> Float e p; +primitive fpDiv : (e : Nat) -> (p : Nat) -> RoundingMode -> Float e p -> Float e p -> Float e p; +primitive fpFMA : (e : Nat) -> (p : Nat) -> RoundingMode -> Float e p -> Float e p -> Float e p -> Float e p; +primitive fpAbs : (e : Nat) -> (p : Nat) -> Float e p -> Float e p; +primitive fpSqrt : (e : Nat) -> (p : Nat) -> RoundingMode -> Float e p -> Float e p; +primitive fpToRational : (e : Nat) -> (p : Nat) -> Float e p -> Rational; +primitive fpFromRational : (e : Nat) -> (p : Nat) -> RoundingMode -> Rational -> Float e p; + +----- Additional floating-point operations needed for Cryptol class instances + +-- Zero +primitive fpPosZero : (e : Nat) -> (p : Nat) -> Float e p; + +-- Eq + +-- | fpIeeeEq is the equivalent of Cryptol's (==) function over Floats. That +-- is, checks if two floating-point values are equal according to how IEEE-754 +-- defines equality. According to fpIeeeEq, fpNaN is not equal to itself, and +-- fpPosZero is equal to fpNegZero. (Contrast this with fpLogicalEq, which +-- checks if two floating-point values are representationally the same.) +primitive fpIeeeEq : (e : Nat) -> (p : Nat) -> Float e p -> Float e p -> Bool; + +-- Cmp +primitive fpLt : (e : Nat) -> (p : Nat) -> Float e p -> Float e p -> Bool; + +fpLe : (e : Nat) -> (p : Nat) -> Float e p -> Float e p -> Bool; +fpLe e p x y = or (fpIeeeEq e p x y) (fpLt e p x y); + +fpCmp : (e : Nat) -> (p : Nat) -> Float e p -> Float e p -> Bool -> Bool; +fpCmp e p x y k = or (fpLt e p x y) (and (fpIeeeEq e p x y) k); + +-- Ring +primitive fpNeg : (e : Nat) -> (p : Nat) -> Float e p -> Float e p; +primitive fpFromInteger : (e : Nat) -> (p : Nat) -> RoundingMode -> Integer -> Float e p; + +-- Round +primitive fpToInteger : (e : Nat) -> (p : Nat) -> RoundingMode -> Float e p -> Integer; + +----- Other floating-point operations + +-- Additional what4 operations +primitive fpIsPos : (e : Nat) -> (p : Nat) -> Float e p -> Bool; +primitive fpRem : (e : Nat) -> (p : Nat) -> Float e p -> Float e p -> Float e p; +primitive fpCast : (e1 : Nat) -> (p1 : Nat) -> (e2 : Nat) -> (p2 : Nat) -> RoundingMode -> Float e1 p1 -> Float e2 p2; +primitive fpRound : (e : Nat) -> (p : Nat) -> RoundingMode -> Float e p -> Float e p; +primitive fpFromBV : (n : Nat) -> (e : Nat) -> (p : Nat) -> RoundingMode -> Vec (Succ n) Bool -> Float e p; +primitive fpFromSBV : (n : Nat) -> (e : Nat) -> (p : Nat) -> RoundingMode -> Vec (Succ n) Bool -> Float e p; +primitive fpToBV : (n : Nat) -> (e : Nat) -> (p : Nat) -> RoundingMode -> Float e p -> Vec (Succ n) Bool; +primitive fpToSBV : (n : Nat) -> (e : Nat) -> (p : Nat) -> RoundingMode -> Float e p -> Vec (Succ n) Bool; + +-- Needed for 'scFloatConst' +fpNegInf : (e : Nat) -> (p : Nat) -> Float e p; +fpNegInf e p = fpNeg e p (fpPosInf e p); + +fpNegZero : (e : Nat) -> (p : Nat) -> Float e p; +fpNegZero e p = fpNeg e p (fpPosZero e p); + -------------------------------------------------------------------------------- -- General axioms diff --git a/saw-core/src/SAWCore/Fingerprint.hs b/saw-core/src/SAWCore/Fingerprint.hs index 1a8fec9d25..3086bcf110 100644 --- a/saw-core/src/SAWCore/Fingerprint.hs +++ b/saw-core/src/SAWCore/Fingerprint.hs @@ -159,6 +159,7 @@ instance Bytes FirstOrderType where FOTRec m -> byte 0x8 <> bytes (Map.size m) <> foldMap (\(k, v) -> bytes k <> byte 0 <> bytes v) (Map.toAscList m) + FOTFloat e p -> byte 0x9 <> bytes e <> bytes p fpTerms :: VarCtx -> [Term] -> FP BS.Builder fpTerms ctx ts = do diff --git a/saw-core/src/SAWCore/FiniteValue.hs b/saw-core/src/SAWCore/FiniteValue.hs index 8860a02cf6..503d8ae32c 100644 --- a/saw-core/src/SAWCore/FiniteValue.hs +++ b/saw-core/src/SAWCore/FiniteValue.hs @@ -1,5 +1,6 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PatternSynonyms #-} {- | Module : SAWCore.FiniteValue @@ -14,6 +15,7 @@ module SAWCore.FiniteValue ( FiniteValue(..), FirstOrderType(..), FirstOrderValue(..), + FirstOrderFloat(..), toFirstOrderValue, toFiniteType, @@ -50,6 +52,7 @@ import Data.Map (Map) import qualified Data.Map as Map import Data.Ratio (numerator, denominator) import qualified Data.Text as Text +import LibBF (BigFloat, pattern NearEven, bfFromBits, bfToBits) import Numeric.Natural (Natural) import Data.Foldable.WithIndex (ifoldrM) @@ -62,6 +65,7 @@ import qualified Data.Aeson as JSON import SAWSupport.Pretty (prettyInteger) import qualified SAWSupport.Pretty as PPS (Doc, Opts) +import SAWCore.FloatHelpers (fpOpts) import qualified SAWCore.Recognizer as R import SAWCore.SharedTerm import SAWCore.Term.Functor @@ -92,6 +96,9 @@ data FirstOrderType | FOTInt | FOTIntMod Natural | FOTRational + | FOTFloat Natural Natural + -- ^ The first 'Natural' is the exponent, and the second 'Natural' is the + -- precision. | FOTVec Natural FirstOrderType | FOTArray FirstOrderType FirstOrderType | FOTTuple [FirstOrderType] @@ -117,6 +124,7 @@ data FirstOrderValue | FOVInt Integer | FOVIntMod Natural Integer | FOVRational Rational + | FOVFloat FirstOrderFloat | FOVWord Natural Integer -- ^ a more efficient special case for 'FOVVec FOTBit _'. | FOVVec FirstOrderType [FirstOrderValue] | FOVArray FirstOrderType FirstOrderValue (Map FirstOrderValue FirstOrderValue) @@ -125,6 +133,43 @@ data FirstOrderValue | FOVRec (Map FieldName FirstOrderValue) deriving (Eq, Ord, Generic) +-- | A 'BigFloat' paired with the number of bits used for its exponent +-- ('fofExp') and precision/significand ('fofPrec'). It is convenient to define +-- this as its own data type for the sake of giving it a 'ToJSON' instance. + +-- (Note that this data type is intentionally very similar to Cryptol's +-- Cryptol.Backend.FloatHelpers.BF.) +data FirstOrderFloat = FirstOrderFloat + { fofExp :: !Natural + , fofPrec :: !Natural + , fofValue :: !BigFloat + } deriving (Eq, Ord) + +instance Pretty FirstOrderFloat where + pretty = viaShow . fofValue + +instance Show FirstOrderFloat where + showsPrec p = showsPrec p . fofValue + +instance FromJSON FirstOrderFloat where + parseJSON = JSON.withObject "FirstOrderFloat" $ \o -> do + e <- o JSON..: "exp" + p <- o JSON..: "prec" + bits <- o JSON..: "value" + pure $ FirstOrderFloat + { fofExp = e + , fofPrec = p + , fofValue = bfFromBits (fpOpts e p NearEven) bits + } + +instance ToJSON FirstOrderFloat where + toJSON (FirstOrderFloat e p v) = + JSON.object + [ "exp" JSON..= e + , "prec" JSON..= p + , "value" JSON..= bfToBits (fpOpts e p NearEven) v + ] + -- -- Note [FOVArray] -- ~~~~~~~~~~~~~~~ @@ -216,6 +261,7 @@ toFiniteType (FOTRec fs) = FTRec <$> traverse toFiniteType fs toFiniteType FOTInt{} = Nothing toFiniteType FOTIntMod{} = Nothing toFiniteType FOTRational{} = Nothing +toFiniteType FOTFloat{} = Nothing toFiniteType FOTArray{} = Nothing instance Show FiniteValue where @@ -228,6 +274,7 @@ instance Show FirstOrderValue where FOVInt i -> shows i FOVIntMod _ i -> shows i FOVRational r -> shows r + FOVFloat fof -> shows fof FOVWord _ x -> shows x FOVVec _ vs -> showString "[" . commaSep (map shows vs) . showString "]" FOVArray _kty d vs -> @@ -259,6 +306,7 @@ prettyFirstOrderValue opts = loop FOVInt i -> pretty i FOVIntMod _ i -> pretty i FOVRational r -> pretty (numerator r) <+> "%" <+> pretty (denominator r) + FOVFloat fof -> pretty fof FOVWord _w i -> prettyInteger opts i FOVVec _ xs -> brackets (align (sep (punctuate comma (map loop xs)))) FOVArray _kty d vs -> @@ -335,6 +383,7 @@ firstOrderTypeOf fv = FOVInt _ -> FOTInt FOVIntMod n _ -> FOTIntMod n FOVRational _ -> FOTRational + FOVFloat (FirstOrderFloat e p _) -> FOTFloat e p FOVWord n _ -> FOTVec n FOTBit FOVVec t vs -> FOTVec (fromIntegral (length vs)) t FOVArray tk d _vs -> FOTArray tk (firstOrderTypeOf d) @@ -387,6 +436,8 @@ asFirstOrderTypeMaybe sc t = -> return (FOTIntMod n) (R.asRationalType -> Just ()) -> return FOTRational + (R.asFloatType -> Just (e, p)) + -> return (FOTFloat e p) (R.isVecType return -> Just (n R.:*: tp)) -> FOTVec n <$> asFirstOrderTypeMaybe sc tp (R.asArrayType -> Just (tp1 R.:*: tp2)) -> do @@ -426,6 +477,9 @@ scFirstOrderType sc ft = FOTInt -> scIntegerType sc FOTIntMod n -> scIntModType sc =<< scNat sc n FOTRational -> scRationalType sc + FOTFloat e p -> do e' <- scNat sc e + p' <- scNat sc p + scFloatType sc e' p' FOTVec n t -> do n' <- scNat sc n t' <- scFirstOrderType sc t scVecType sc n' t' @@ -452,6 +506,7 @@ scFirstOrderValue sc fv = i' <- scNatToInt sc =<< scNat sc (fromInteger (i `mod` toInteger n)) scToIntMod sc n' i' FOVRational r -> scRationalConst sc r + FOVFloat (FirstOrderFloat e p bf) -> scFloatConst sc e p bf FOVWord n x -> scBvConst sc n x FOVVec t vs -> do t' <- scFirstOrderType sc t vs' <- traverse (scFirstOrderValue sc) vs diff --git a/saw-core/src/SAWCore/FloatHelpers.hs b/saw-core/src/SAWCore/FloatHelpers.hs new file mode 100644 index 0000000000..d515eea44e --- /dev/null +++ b/saw-core/src/SAWCore/FloatHelpers.hs @@ -0,0 +1,206 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} + +{- | +Module : SAWCore.FloatHelpers +Copyright : Galois, Inc. 2026 +License : BSD3 +Maintainer : huffman@galois.com +Stability : experimental +Portability : non-portable (language extensions) + +Utility functions for dealing with "LibBF". This is heavily inspired by +Cryptol's @Cryptol.Backend.FloatHelpers@ module. +-} +module SAWCore.FloatHelpers + ( fpCheckStatus + , fpOpts + , fpRound + , floatFromInteger + , floatFromRational + , floatToRational + , floatToInteger + , NotRationalError(..) + , ppNotRationalError + , floatFromBits + , floatToBits + , floatToBV + , floatToSBV + , NotBitvectorError(..) + , ppNotBitvectorError + ) where + +import Data.Bits (Bits(..)) +import Data.Ratio (numerator, denominator) +import qualified Data.Text as Text +import LibBF +import Numeric.Natural (Natural) + +import SAWCore.Panic (panic) + +-- | Check that we didn't get an unexpected status. +fpCheckStatus :: (BigFloat, Status) -> BigFloat +fpCheckStatus (r,s) = + case s of + MemError -> panic "fpCheckStatus" [ "libBF: Memory error" ] + _ -> r + +-- | Make LibBF options for the given precision and rounding mode. +fpOpts :: Natural -> Natural -> RoundMode -> BFOpts +fpOpts e p r = + case ok of + Just opts -> opts + Nothing -> panic "fpOpts" [ "Invalid Float size" + , "exponent: " <> Text.pack (show e) + , "precision: " <> Text.pack (show p) + ] + where + ok :: Maybe BFOpts + ok = do eb <- rng expBits expBitsMin expBitsMax e + pb <- rng precBits precBitsMin precBitsMax p + pure (eb <> pb <> allowSubnormal <> rnd r) + + rng :: + forall a. + Integral a => + (a -> BFOpts) -> + Int -> + Int -> + Natural -> + Maybe BFOpts + rng f a b x = + if fromIntegral @Int @Natural a <= x && x <= fromIntegral @Int @Natural b + then Just (f (fromIntegral @Natural @a x)) + else Nothing + +-- | Mapping from the rounding modes defined in the @Float.cry@ module to the +-- rounding modes of LibBF. +fpRound :: Integer -> Maybe RoundMode +fpRound n = + case n of + 0 -> Just NearEven + 1 -> Just NearAway + 2 -> Just ToPosInf + 3 -> Just ToNegInf + 4 -> Just ToZero + _ -> Nothing + +-- | Make a floating point number from an integer, using the given rounding +-- mode. +floatFromInteger :: BFOpts -> Integer -> BigFloat +floatFromInteger opts i = fpCheckStatus (bfRoundFloat opts (bfFromInteger i)) + +-- | Make a floating point number from a rational, using the given rounding +-- mode. +floatFromRational :: Natural -> Natural -> RoundMode -> Rational -> BigFloat +floatFromRational e p r rat = + fpCheckStatus $ + if den == 1 + then bfRoundFloat opts num + else bfDiv opts num (bfFromInteger den) + where + opts = fpOpts e p r + + num = bfFromInteger (numerator rat) + den = denominator rat + +-- | Convert a floating-point number to a 'Rational' if possible. Return 'Left' +-- if the input is infinite or NaN. +floatToRational :: BigFloat -> Either NotRationalError Rational +floatToRational bf = + case bfToRep bf of + BFNaN -> Left IsNaN + BFRep s num -> + case num of + Inf -> Left IsInf + Zero -> Right 0 + Num i ev -> Right $ + case s of + Pos -> ab + Neg -> negate ab + where ab = fromInteger i * (2 ^^ ev) + +-- | Convert a floating point number to an integer, if possible. Return 'Left' +-- if the input is infinite or NaN. +floatToInteger :: RoundMode -> BigFloat -> Either NotRationalError Integer +floatToInteger r fp = + do rat <- floatToRational fp + pure $ + case r of + NearEven -> round rat + NearAway -> roundAway rat + ToPosInf -> ceiling rat + ToNegInf -> floor rat + ToZero -> truncate rat + _ -> panic "floatToInteger" + ["Unexpected rounding mode", Text.pack (show r)] + where + -- | Evaluate a rational to an integer with rounding away from zero. + roundAway :: Rational -> Integer + roundAway r' = truncate (r' + signum r' * 0.5) + +-- | Why a floating-point value cannot be represented as a 'Rational'. +data NotRationalError = IsNaN | IsInf + +ppNotRationalError :: NotRationalError -> String +ppNotRationalError IsNaN = "NaN value cannot be represented as a Rational" +ppNotRationalError IsInf = "Infinite value cannot be represented as a Rational" + +floatFromBits :: + Natural {- ^ Exponent width -} -> + Natural {- ^ Precision width -} -> + Integer {- ^ Raw bits -} -> + BigFloat +floatFromBits e p bv = bfFromBits (fpOpts e p NearEven) bv + +-- | Turn a float into raw bits. +-- @NaN@ is represented as a positive "quiet" @NaN@ +-- (most significant bit in the significand is set, the rest of it is 0) +floatToBits :: Natural -> Natural -> BigFloat -> Integer +floatToBits e p bf = bfToBits (fpOpts e p NearEven) bf + +-- | Convert a floating point number to an unsigned bitvector. If the value of +-- the float does not lie within the range of possible unsigned bitvector +-- values, then this will return 'Left'. +floatToBV :: Natural -> RoundMode -> BigFloat -> Either NotBitvectorError Integer +floatToBV w r bf = + case floatToInteger r bf of + Left e -> Left $ IsSpecialValue e + Right i -> + if 0 <= i && i <= maxUnsigned + then Right i + else Left IsOutsideRange + where + maxUnsigned :: Integer + maxUnsigned = bit (fromIntegral @Natural @Int w) - 1 + +-- | Convert a floating point number to a signed bitvector. If the value of the +-- float does not lie within the range of possible signed bitvector values, +-- then this will return 'Left'. +floatToSBV :: Natural -> RoundMode -> BigFloat -> Either NotBitvectorError Integer +floatToSBV w r bf = + case floatToInteger r bf of + Left e -> Left $ IsSpecialValue e + Right i -> + if minSigned <= i && i <= maxSigned + then Right i + else Left IsOutsideRange + where + signedUpperBound :: Integer + signedUpperBound = bit (fromIntegral @Natural @Int w - 1) + + minSigned, maxSigned :: Integer + minSigned = negate signedUpperBound + maxSigned = signedUpperBound - 1 + +-- | Why a floating-point value cannot be represented as a bitvector. +data NotBitvectorError + = IsSpecialValue NotRationalError + -- ^ The value is infinite or NaN. + | IsOutsideRange + -- ^ The value lies outside the range of possible bitvector values. + +ppNotBitvectorError :: NotBitvectorError -> String +ppNotBitvectorError (IsSpecialValue e) = ppNotRationalError e +ppNotBitvectorError IsOutsideRange = "Float lies outside range of possible bitvector values" diff --git a/saw-core/src/SAWCore/Prelude.hs b/saw-core/src/SAWCore/Prelude.hs index f242da9002..f6d3e703a4 100644 --- a/saw-core/src/SAWCore/Prelude.hs +++ b/saw-core/src/SAWCore/Prelude.hs @@ -79,6 +79,14 @@ scDecEq sc fot args = case fot of Nothing -> return fn Just (x,y) -> scApplyAll sc fn [x,y] + FOTFloat e p -> + do fn <- scGlobalDef sc "Prelude.fpLogicalEq" + e' <- scNat sc e + p' <- scNat sc p + case args of + Nothing -> scApplyAll sc fn [e',p'] + Just (x,y) -> scApplyAll sc fn [e',p',x,y] + FOTVec w FOTBit -> do fn <- scGlobalDef sc "Prelude.bvEq" w' <- scNat sc w diff --git a/saw-core/src/SAWCore/Recognizer.hs b/saw-core/src/SAWCore/Recognizer.hs index c1fb98c5e0..ea8a9b7bd8 100644 --- a/saw-core/src/SAWCore/Recognizer.hs +++ b/saw-core/src/SAWCore/Recognizer.hs @@ -62,6 +62,7 @@ module SAWCore.Recognizer , asIntegerType , asIntModType , asRationalType + , asFloatType , asBitvectorType , asVectorType , asVecType @@ -440,6 +441,9 @@ asIntModType = isGlobalDef "Prelude.IntMod" @> asNat asRationalType :: Recognizer Term () asRationalType = isGlobalDef "Prelude.Rational" +asFloatType :: Recognizer Term (Natural, Natural) +asFloatType = fmap toPair . ((isGlobalDef "Prelude.Float" @> asNat) <@> asNat) + asVectorType :: Recognizer Term (Term, Term) asVectorType = fmap toPair . ((isGlobalDef "Prelude.Vec" @> return) <@> return) diff --git a/saw-core/src/SAWCore/SharedTerm.hs b/saw-core/src/SAWCore/SharedTerm.hs index 5b43ef3eb9..de7a074233 100644 --- a/saw-core/src/SAWCore/SharedTerm.hs +++ b/saw-core/src/SAWCore/SharedTerm.hs @@ -281,6 +281,48 @@ module SAWCore.SharedTerm , scRational , scRationalConst , scRationalType + -- ** Floats + , scFloat + , scFloatConst + , scFloatType + , scFpAbs + , scFpAdd + , scFpCast + , scFpDiv + , scFpFMA + , scFpFromBits + , scFpFromBV + , scFpFromSBV + , scFpIeeeEq + , scFpIsInf + , scFpIsNaN + , scFpIsNeg + , scFpIsNormal + , scFpIsPos + , scFpIsSubnormal + , scFpIsZero + , scFpLe + , scFpLt + , scFpLogicalEq + , scFpMul + , scFpNaN + , scFpNeg + , scFpNegInf + , scFpNegZero + , scFpPosInf + , scFpPosZero + , scFpRem + , scFpRound + , scFpSqrt + , scFpSub + , scFpToBits + , scFpToBV + , scFpToSBV + , scRoundNearestEven + , scRoundNearestAway + , scRoundPositive + , scRoundNegative + , scRoundZero -- * Miscellaneous , alistAllFields , scImport @@ -313,6 +355,8 @@ import qualified Data.Text as Text import Data.Typeable import Data.Set (Set) import qualified Data.Set as Set +import LibBF (BigFloat) +import qualified LibBF as BF import Numeric.Natural (Natural) import qualified Prettyprinter as PP @@ -321,6 +365,7 @@ import qualified SAWSupport.Pretty as PPS (Doc, Opts, defaultOpts, render, rende import SAWCore.Cache import SAWCore.Change +import SAWCore.FloatHelpers (NotRationalError(..), floatToRational) import SAWCore.Module ( ctorNumParams , moduleIsLoaded @@ -2096,6 +2141,187 @@ scArraySet sc n a f i e l = scGlobalApply sc "Prelude.arraySet" [n, a, f, i, e, scArrayRangeEq :: SharedContext -> Term -> Term -> Term -> Term -> Term -> Term -> Term -> IO Term scArrayRangeEq sc n a f i g j l = scGlobalApply sc "Prelude.arrayRangeEq" [n, a, f, i, g, j, l] +-- | Create an floating-point constant term from a 'BigFloat', along with the +-- sizes of its exponent and precision represented as 'Term's. +scFloat :: SharedContext -> Term -> Term -> BigFloat -> IO Term +scFloat sc e p bf = do + case floatToRational bf of + Left IsNaN -> scFpNaN sc e p + Left IsInf + | BF.bfIsNeg bf -> scFpNegInf sc e p + | otherwise -> scFpPosInf sc e p + Right 0 + | BF.bfIsNeg bf -> scFpNegZero sc e p + | otherwise -> scFpPosZero sc e p + Right r -> do + r' <- scRationalConst sc r + m' <- scRoundNearestEven sc + scGlobalApply sc "Prelude.fpFromRational" [e, p, m', r'] + +-- | Create an floating-point constant term from a 'BigFloat', along with the +-- sizes of its exponent and precision represented as 'Natural's. +scFloatConst :: SharedContext -> Natural -> Natural -> BigFloat -> IO Term +scFloatConst sc e p bf = do + e' <- scNat sc e + p' <- scNat sc p + scFloat sc e' p' bf + +-- | Create a term representing the saw-core type @Float@. +scFloatType :: SharedContext -> Term -> Term -> IO Term +scFloatType sc e p = scGlobalApply sc "Prelude.Float" [e, p] + +-- primitive fpAbs : (e : Nat) -> (p : Nat) -> Float e p -> Float e p; +scFpAbs :: SharedContext -> Term -> Term -> Term -> IO Term +scFpAbs sc e p f = scGlobalApply sc "Prelude.fpAbs" [e, p, f] + +-- primitive fpAdd : (e : Nat) -> (p : Nat) -> RoundingMode -> Float e p -> Float e p -> Float e p; +scFpAdd :: SharedContext -> Term -> Term -> Term -> Term -> Term -> IO Term +scFpAdd sc e p m f1 f2 = scGlobalApply sc "Prelude.fpAdd" [e, p, m, f1, f2] + +-- primitive fpCast : (e1 : Nat) (p1 : Nat) (e2 : Nat) (p2 : Nat) -> RoundingMode -> Float e1 p1 -> Float e2 p2; +scFpCast :: SharedContext -> Term -> Term -> Term -> Term -> Term -> Term -> IO Term +scFpCast sc e1 p1 e2 p2 m f = scGlobalApply sc "Prelude.fpCast" [e1, p1, e2, p2, m, f] + +-- primitive fpDiv : (e : Nat) -> (p : Nat) -> RoundingMode -> Float e p -> Float e p -> Float e p; +scFpDiv :: SharedContext -> Term -> Term -> Term -> Term -> Term -> IO Term +scFpDiv sc e p m f1 f2 = scGlobalApply sc "Prelude.fpDiv" [e, p, m, f1, f2] + +-- primitive fpFMA : (e : Nat) -> (p : Nat) -> RoundingMode -> Float e p -> Float e p -> Float e p -> Float e p; +scFpFMA :: SharedContext -> Term -> Term -> Term -> Term -> Term -> Term -> IO Term +scFpFMA sc e p m f1 f2 f3 = scGlobalApply sc "Prelude.fpFMA" [e, p, m, f1, f2, f3] + +-- primitive fpFromBits : (e : Nat) -> (p : Nat) -> Vec (addNat e p) Bool -> Float e p; +scFpFromBits :: SharedContext -> Term -> Term -> Term -> IO Term +scFpFromBits sc e p v = scGlobalApply sc "Prelude.fpFromBits" [e, p, v] + +-- primitive fpFromBV : (n : Nat) (e : Nat) -> (p : Nat) -> RoundingMode -> Vec (Succ n) Bool -> Float e p; +scFpFromBV :: SharedContext -> Term -> Term -> Term -> Term -> Term -> IO Term +scFpFromBV sc n e p m v = scGlobalApply sc "Prelude.fpFromBV" [n, e, p, m, v] + +-- primitive fpFromSBV : (n : Nat) (e : Nat) -> (p : Nat) -> RoundingMode -> Vec (Succ n) Bool -> Float e p; +scFpFromSBV :: SharedContext -> Term -> Term -> Term -> Term -> Term -> IO Term +scFpFromSBV sc n e p m v = scGlobalApply sc "Prelude.fpFromSBV" [n, e, p, m, v] + +-- primitive fpIeeeEq : (e : Nat) -> (p : Nat) -> Float e p -> Float e p -> Bool; +scFpIeeeEq :: SharedContext -> Term -> Term -> Term -> Term -> IO Term +scFpIeeeEq sc e p f1 f2 = scGlobalApply sc "Prelude.fpIeeeEq" [e, p, f1, f2] + +-- primitive fpIsInf : (e : Nat) -> (p : Nat) -> Float e p -> Bool; +scFpIsInf :: SharedContext -> Term -> Term -> Term -> IO Term +scFpIsInf sc e p f = scGlobalApply sc "Prelude.fpIsInf" [e, p, f] + +-- primitive fpIsNaN : (e : Nat) -> (p : Nat) -> Float e p -> Bool; +scFpIsNaN :: SharedContext -> Term -> Term -> Term -> IO Term +scFpIsNaN sc e p f = scGlobalApply sc "Prelude.fpIsNaN" [e, p, f] + +-- primitive fpIsNeg : (e : Nat) -> (p : Nat) -> Float e p -> Bool; +scFpIsNeg :: SharedContext -> Term -> Term -> Term -> IO Term +scFpIsNeg sc e p f = scGlobalApply sc "Prelude.fpIsNeg" [e, p, f] + +-- primitive fpIsNormal : (e : Nat) -> (p : Nat) -> Float e p -> Bool; +scFpIsNormal :: SharedContext -> Term -> Term -> Term -> IO Term +scFpIsNormal sc e p f = scGlobalApply sc "Prelude.fpIsNormal" [e, p, f] + +-- primitive fpIsPos : (e : Nat) -> (p : Nat) -> Float e p -> Bool; +scFpIsPos :: SharedContext -> Term -> Term -> Term -> IO Term +scFpIsPos sc e p f = scGlobalApply sc "Prelude.fpIsPos" [e, p, f] + +-- primitive fpIsSubnormal : (e : Nat) -> (p : Nat) -> Float e p -> Bool; +scFpIsSubnormal :: SharedContext -> Term -> Term -> Term -> IO Term +scFpIsSubnormal sc e p f = scGlobalApply sc "Prelude.fpIsSubnormal" [e, p, f] + +-- primitive fpIsZero : (e : Nat) -> (p : Nat) -> Float e p -> Bool; +scFpIsZero :: SharedContext -> Term -> Term -> Term -> IO Term +scFpIsZero sc e p f = scGlobalApply sc "Prelude.fpIsZero" [e, p, f] + +-- fpLe : (e : Nat) -> (p : Nat) -> Float e p -> Float e p -> Bool; +scFpLe :: SharedContext -> Term -> Term -> Term -> Term -> IO Term +scFpLe sc e p f1 f2 = scGlobalApply sc "Prelude.fpLe" [e, p, f1, f2] + +-- primitive fpLt : (e : Nat) -> (p : Nat) -> Float e p -> Float e p -> Bool; +scFpLt :: SharedContext -> Term -> Term -> Term -> Term -> IO Term +scFpLt sc e p f1 f2 = scGlobalApply sc "Prelude.fpLt" [e, p, f1, f2] + +-- primitive fpLogicalEq : (e : Nat) -> (p : Nat) -> Float e p -> Float e p -> Bool; +scFpLogicalEq :: SharedContext -> Term -> Term -> Term -> Term -> IO Term +scFpLogicalEq sc e p f1 f2 = scGlobalApply sc "Prelude.fpLogicalEq" [e, p, f1, f2] + +-- primitive fpMul : (e : Nat) -> (p : Nat) -> RoundingMode -> Float e p -> Float e p -> Float e p; +scFpMul :: SharedContext -> Term -> Term -> Term -> Term -> Term -> IO Term +scFpMul sc e p m f1 f2 = scGlobalApply sc "Prelude.fpMul" [e, p, m, f1, f2] + +-- primitive fpNaN : (e : Nat) -> (p : Nat) -> Float e p; +scFpNaN :: SharedContext -> Term -> Term -> IO Term +scFpNaN sc e p = scGlobalApply sc "Prelude.fpNaN" [e, p] + +-- primitive fpNeg : (e : Nat) -> (p : Nat) -> Float e p -> Float e p; +scFpNeg :: SharedContext -> Term -> Term -> Term -> IO Term +scFpNeg sc e p f = scGlobalApply sc "Prelude.fpNeg" [e, p, f] + +-- fpNegInf : (e : Nat) -> (p : Nat) -> Float e p; +scFpNegInf :: SharedContext -> Term -> Term -> IO Term +scFpNegInf sc e p = scGlobalApply sc "Prelude.fpNegInf" [e, p] + +-- fpNegZero : (e : Nat) -> (p : Nat) -> Float e p; +scFpNegZero :: SharedContext -> Term -> Term -> IO Term +scFpNegZero sc e p = scGlobalApply sc "Prelude.fpNegZero" [e, p] + +-- primitive fpPosInf : (e : Nat) -> (p : Nat) -> Float e p; +scFpPosInf :: SharedContext -> Term -> Term -> IO Term +scFpPosInf sc e p = scGlobalApply sc "Prelude.fpPosInf" [e, p] + +-- primitive fpPosZero : (e : Nat) -> (p : Nat) -> Float e p; +scFpPosZero :: SharedContext -> Term -> Term -> IO Term +scFpPosZero sc e p = scGlobalApply sc "Prelude.fpPosZero" [e, p] + +-- primitive fpRem : (e : Nat) -> (p : Nat) -> Float e p -> Float e p -> Float e p; +scFpRem :: SharedContext -> Term -> Term -> Term -> Term -> IO Term +scFpRem sc e p f1 f2 = scGlobalApply sc "Prelude.fpRem" [e, p, f1, f2] + +-- primitive fpRound : (e : Nat) -> (p : Nat) -> RoundingMode -> Float e p -> Float e p; +scFpRound :: SharedContext -> Term -> Term -> Term -> Term -> IO Term +scFpRound sc e p m f = scGlobalApply sc "Prelude.fpRound" [e, p, m, f] + +-- primitive fpSqrt : (e : Nat) -> (p : Nat) -> RoundingMode -> Float e p -> Float e p; +scFpSqrt :: SharedContext -> Term -> Term -> Term -> Term -> IO Term +scFpSqrt sc e p m f = scGlobalApply sc "Prelude.fpSqrt" [e, p, m, f] + +-- primitive fpSub : (e : Nat) -> (p : Nat) -> RoundingMode -> Float e p -> Float e p -> Float e p; +scFpSub :: SharedContext -> Term -> Term -> Term -> Term -> Term -> IO Term +scFpSub sc e p m f1 f2 = scGlobalApply sc "Prelude.fpSub" [e, p, m, f1, f2] + +-- primitive fpToBits : (e : Nat) -> (p : Nat) -> Float e p -> Vec (addNat e p) Bool; +scFpToBits :: SharedContext -> Term -> Term -> Term -> IO Term +scFpToBits sc e p f = scGlobalApply sc "Prelude.fpToBits" [e, p, f] + +-- primitive fpToBV : (n : Nat) (e : Nat) -> (p : Nat) -> RoundingMode -> Float e p -> Vec (Succ n) Bool; +scFpToBV :: SharedContext -> Term -> Term -> Term -> Term -> Term -> IO Term +scFpToBV sc n e p m f = scGlobalApply sc "Prelude.fpToBV" [n, e, p, m, f] + +-- primitive fpToSBV : (n : Nat) (e : Nat) -> (p : Nat) -> RoundingMode -> Float e p -> Vec (Succ n) Bool; +scFpToSBV :: SharedContext -> Term -> Term -> Term -> Term -> Term -> IO Term +scFpToSBV sc n e p m f = scGlobalApply sc "Prelude.fpToSBV" [n, e, p, m, f] + +-- roundNearestEven : RoundingMode; +scRoundNearestEven :: SharedContext -> IO Term +scRoundNearestEven sc = scGlobalDef sc "Prelude.roundNearestEven" + +-- roundNearestAway : RoundingMode; +scRoundNearestAway :: SharedContext -> IO Term +scRoundNearestAway sc = scGlobalDef sc "Prelude.roundNearestAway" + +-- roundPositive : RoundingMode; +scRoundPositive :: SharedContext -> IO Term +scRoundPositive sc = scGlobalDef sc "Prelude.roundPositive" + +-- roundNegative : RoundingMode; +scRoundNegative :: SharedContext -> IO Term +scRoundNegative sc = scGlobalDef sc "Prelude.roundNegative" + +-- roundZero : RoundingMode; +scRoundZero :: SharedContext -> IO Term +scRoundZero sc = scGlobalDef sc "Prelude.roundZero" + ------------------------------------------------------------ useChangeCache :: C m => IntCache m (Change v) -> Int -> ChangeT m v -> ChangeT m v diff --git a/saw-core/src/SAWCore/Simulator/Concrete.hs b/saw-core/src/SAWCore/Simulator/Concrete.hs index 7e33faa4fe..2b8fc3cc8d 100644 --- a/saw-core/src/SAWCore/Simulator/Concrete.hs +++ b/saw-core/src/SAWCore/Simulator/Concrete.hs @@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {- | @@ -29,8 +30,14 @@ import Data.IntTrie (IntTrie) import qualified Data.IntTrie as IntTrie import Data.Map (Map) import qualified Data.Map as Map +import Data.Ratio ((%), numerator, denominator) import qualified Data.Text as Text +import LibBF (BFOpts, BigFloat, Status) +import qualified LibBF as BF +import Numeric.Natural (Natural) +import SAWCore.FiniteValue (FirstOrderFloat(..)) +import SAWCore.FloatHelpers import SAWCore.Module (ModuleMap) import SAWCore.Name import SAWCore.Panic (panic) @@ -79,6 +86,7 @@ type instance EvalM Concrete = Identity type instance VBool Concrete = Bool type instance VWord Concrete = BitVector type instance VInt Concrete = Integer +type instance VFloat Concrete = FirstOrderFloat type instance VArray Concrete = () type instance Extra Concrete = CExtra @@ -134,6 +142,12 @@ pure2 f x y = pure (f x y) pure3 :: Applicative f => (a -> b -> c -> d) -> a -> b -> c -> f d pure3 f x y z = pure (f x y z) +pure4 :: Applicative f => (a -> b -> c -> d -> e) -> a -> b -> c -> d -> f e +pure4 f w x y z = pure (f w x y z) + +pure5 :: Applicative m => (a -> b -> c -> d -> e -> f) -> a -> b -> c -> d -> e -> m f +pure5 f v w x y z = pure (f v w x y z) + divOp :: (a -> b -> Maybe c) -> a -> b -> Identity c divOp f x y = maybe Prim.divideByZero pure (f x y) @@ -156,6 +170,7 @@ prims = , Prims.bpMuxBool = pure3 ite , Prims.bpMuxWord = pure3 ite , Prims.bpMuxInt = pure3 ite + , Prims.bpMuxFloat = pure3 ite , Prims.bpMuxArray = unsupportedConcretePrimitive "bpMuxArray" , Prims.bpMuxExtra = pure3 ite -- Booleans @@ -221,6 +236,114 @@ prims = , Prims.bpIntMax = pure2 max , Prims.bpNatToInt = pure1 toInteger + -- Float operations + , Prims.bpFpAbs = pure1 (\x -> x { fofValue = BF.bfAbs (fofValue x) }) + , Prims.bpFpAdd = fpBinArith BF.bfAdd + , Prims.bpFpCast = pure4 $ \e p r x -> + let opts = fpOpts e p (fpRoundMode r) in + x { fofValue = fpCheckStatus (BF.bfRoundFloat opts (fofValue x)) } + , Prims.bpFpDiv = fpBinArith BF.bfDiv + , Prims.bpFpFMA = pure4 $ \r x y z -> + let opts = fpOpts (fofExp x) (fofPrec x) (fpRoundMode r) in + x { fofValue = fpCheckStatus (BF.bfFMA opts (fofValue x) (fofValue y) (fofValue z)) } + , Prims.bpFpFromBits = pure3 $ \e p x -> + FirstOrderFloat + { fofExp = e + , fofPrec = p + , fofValue = floatFromBits e p (unsigned x) + } + , Prims.bpFpFromInteger = pure4 $ \e p r x -> + FirstOrderFloat + { fofExp = e + , fofPrec = p + , fofValue = fpCheckStatus (BF.bfRoundInt (fpRoundMode r) (BF.bfFromInteger x)) + } + , Prims.bpFpFromRational = pure5 $ \e p r numer denom -> + FirstOrderFloat + { fofExp = e + , fofPrec = p + , fofValue = floatFromRational e p (fpRoundMode r) (numer % denom) + } + , Prims.bpFpFromBV = pure4 $ \e p r x -> + let opts = fpOpts e p (fpRoundMode r) in + FirstOrderFloat + { fofExp = e + , fofPrec = p + , fofValue = floatFromInteger opts (unsigned x) + } + , Prims.bpFpFromSBV = pure4 $ \e p r x -> + let opts = fpOpts e p (fpRoundMode r) in + FirstOrderFloat + { fofExp = e + , fofPrec = p + , fofValue = floatFromInteger opts (signed x) + } + , Prims.bpFpIeeeEq = pure2 (\x y -> fofValue x == fofValue y) + , Prims.bpFpIsInf = pure1 (\x -> BF.bfIsInf (fofValue x)) + , Prims.bpFpIsNaN = pure1 (\x -> BF.bfIsNaN (fofValue x)) + , Prims.bpFpIsNeg = pure1 (\x -> BF.bfIsNeg (fofValue x)) + , Prims.bpFpIsNormal = pure1 $ \x -> + let opts = fpOpts (fofExp x) (fofPrec x) BF.NearEven in + BF.bfIsNormal opts (fofValue x) + , Prims.bpFpIsPos = pure1 (\x -> BF.bfIsPos (fofValue x)) + , Prims.bpFpIsSubnormal = pure1 $ \x -> + let opts = fpOpts (fofExp x) (fofPrec x) BF.NearEven in + BF.bfIsSubnormal opts (fofValue x) + , Prims.bpFpIsZero = pure1 (\x -> BF.bfIsZero (fofValue x)) + , Prims.bpFpLt = pure2 (\x y -> fofValue x < fofValue y) + , Prims.bpFpLogicalEq = pure2 (\x y -> BF.bfCompare (fofValue x) (fofValue y) == EQ) + , Prims.bpFpMul = fpBinArith BF.bfMul + , Prims.bpFpNaN = pure2 $ \e p -> + FirstOrderFloat + { fofExp = e + , fofPrec = p + , fofValue = BF.bfNaN + } + , Prims.bpFpNeg = pure1 (\x -> x { fofValue = BF.bfNeg (fofValue x) }) + , Prims.bpFpPosInf = pure2 $ \e p -> + FirstOrderFloat + { fofExp = e + , fofPrec = p + , fofValue = BF.bfPosInf + } + , Prims.bpFpPosZero = pure2 $ \e p -> + FirstOrderFloat + { fofExp = e + , fofPrec = p + , fofValue = BF.bfPosZero + } + , Prims.bpFpRem = pure2 $ \x y -> + let opts = fpOpts (fofExp x) (fofPrec x) BF.NearEven in + x { fofValue = fpCheckStatus (BF.bfRem opts (fofValue x) (fofValue y)) } + , Prims.bpFpRound = pure2 $ \r x -> + let r' = fpRoundMode r in + let opts = fpOpts (fofExp x) (fofPrec x) r' in + let x' = fpCheckStatus (BF.bfRoundInt r' (fofValue x)) in + x { fofValue = fpCheckStatus (BF.bfRoundFloat opts x') } + , Prims.bpFpSqrt = pure2 $ \r x -> + let opts = fpOpts (fofExp x) (fofPrec x) (fpRoundMode r) in + x { fofValue = fpCheckStatus (BF.bfSqrt opts (fofValue x)) } + , Prims.bpFpSub = fpBinArith BF.bfSub + , Prims.bpFpToBits = pure1 $ \x -> + let e = fofExp x in + let p = fofPrec x in + bv (fromIntegral @Natural @Int (e+p)) (floatToBits e p (fofValue x)) + , Prims.bpFpToBV = pure3 $ \w r x -> + case floatToBV w (fpRoundMode r) (fofValue x) of + Right i -> bv (fromIntegral @Natural @Int w) i + Left err -> error $ ppNotBitvectorError err + , Prims.bpFpToInteger = pure2 $ \r x -> + case floatToInteger (fpRoundMode r) (fofValue x) of + Right i -> i + Left err -> error $ ppNotRationalError err + , Prims.bpFpToRational = pure1 $ \x -> + case floatToRational (fofValue x) of + Right r -> (numerator r, denominator r) + Left err -> error $ ppNotRationalError err + , Prims.bpFpToSBV = pure3 $ \w r x -> + case floatToSBV w (fpRoundMode r) (fofValue x) of + Right i -> bv (fromIntegral @Natural @Int w) i + Left err -> error $ ppNotBitvectorError err -- Array operations , Prims.bpArrayConstant = unsupportedConcretePrimitive "bpArrayConstant" , Prims.bpArrayLookup = unsupportedConcretePrimitive "bpArrayLookup" @@ -357,3 +480,22 @@ streamRecOp = Prims.Prim $ do let f = vStrictFun $ \ix -> pure (streamGet (toStream xs) ix) apply f1 (ready f) + +------------------------------------------------------------ + +fpBinArith :: + (BFOpts -> BigFloat -> BigFloat -> (BigFloat, Status)) -> + BitVector {- ^ Rouding mode -} -> + FirstOrderFloat -> + FirstOrderFloat -> + Identity FirstOrderFloat +fpBinArith fun = pure3 $ \r x y -> + let opts = fpOpts (fofExp x) (fofPrec x) (fpRoundMode r) in + x { fofValue = fpCheckStatus (fun opts (fofValue x) (fofValue y)) } + +fpRoundMode :: BitVector -> BF.RoundMode +fpRoundMode w = + let uw = unsigned w in + case fpRound uw of + Nothing -> error $ "Invalid rounding mode: " ++ show uw + Just a -> a diff --git a/saw-core/src/SAWCore/Simulator/Prims.hs b/saw-core/src/SAWCore/Simulator/Prims.hs index 54fce4d082..58d2a880e4 100644 --- a/saw-core/src/SAWCore/Simulator/Prims.hs +++ b/saw-core/src/SAWCore/Simulator/Prims.hs @@ -130,6 +130,12 @@ intModFun = PrimFilterFun "expected IntMod" r where r (VIntMod _ i) = pure i r _ = mzero +-- | A primitive that requires a @Float@ argument +floatFun :: VMonad l => (VFloat l -> Prim l) -> Prim l +floatFun = PrimFilterFun "expected Float" r + where r (VFloat f) = pure f + r _ = mzero + -- | A primitive that requires a rational argument ratFun :: VMonad l => ((VInt l, VInt l) -> Prim l) -> Prim l ratFun = PrimFilterFun "expected Rational" r @@ -189,6 +195,7 @@ data BasePrims l = , bpMuxBool :: VBool l -> VBool l -> VBool l -> MBool l , bpMuxWord :: VBool l -> VWord l -> VWord l -> MWord l , bpMuxInt :: VBool l -> VInt l -> VInt l -> MInt l + , bpMuxFloat :: VBool l -> VFloat l -> VFloat l -> MFloat l , bpMuxArray :: VBool l -> VArray l -> VArray l -> MArray l , bpMuxExtra :: VBool l -> Extra l -> Extra l -> EvalM l (Extra l) -- Booleans @@ -252,6 +259,41 @@ data BasePrims l = , bpIntMin :: VInt l -> VInt l -> MInt l , bpIntMax :: VInt l -> VInt l -> MInt l , bpNatToInt :: Natural -> MInt l + -- Float operations + , bpFpAbs :: VFloat l -> MFloat l + , bpFpAdd :: VWord l -> VFloat l -> VFloat l -> MFloat l + , bpFpCast :: Natural -> Natural -> VWord l -> VFloat l -> MFloat l + , bpFpDiv :: VWord l -> VFloat l -> VFloat l -> MFloat l + , bpFpFMA :: VWord l -> VFloat l -> VFloat l -> VFloat l -> MFloat l + , bpFpFromBits :: Natural -> Natural -> VWord l -> MFloat l + , bpFpFromBV :: Natural -> Natural -> VWord l -> VWord l -> MFloat l + , bpFpFromInteger :: Natural -> Natural -> VWord l -> VInt l -> MFloat l + , bpFpFromRational :: Natural -> Natural -> VWord l -> VInt l -> VInt l -> MFloat l + , bpFpFromSBV :: Natural -> Natural -> VWord l -> VWord l -> MFloat l + , bpFpIeeeEq :: VFloat l -> VFloat l -> MBool l + , bpFpIsInf :: VFloat l -> MBool l + , bpFpIsNaN :: VFloat l -> MBool l + , bpFpIsNeg :: VFloat l -> MBool l + , bpFpIsNormal :: VFloat l -> MBool l + , bpFpIsPos :: VFloat l -> MBool l + , bpFpIsSubnormal :: VFloat l -> MBool l + , bpFpIsZero :: VFloat l -> MBool l + , bpFpLt :: VFloat l -> VFloat l -> MBool l + , bpFpLogicalEq :: VFloat l -> VFloat l -> MBool l + , bpFpMul :: VWord l -> VFloat l -> VFloat l -> MFloat l + , bpFpNaN :: Natural -> Natural -> MFloat l + , bpFpNeg :: VFloat l -> MFloat l + , bpFpPosInf :: Natural -> Natural -> MFloat l + , bpFpPosZero :: Natural -> Natural -> MFloat l + , bpFpRem :: VFloat l -> VFloat l -> MFloat l + , bpFpRound :: VWord l -> VFloat l -> MFloat l + , bpFpSqrt :: VWord l -> VFloat l -> MFloat l + , bpFpSub :: VWord l -> VFloat l -> VFloat l -> MFloat l + , bpFpToBits :: VFloat l -> MWord l + , bpFpToBV :: Natural -> VWord l -> VFloat l -> MWord l + , bpFpToInteger :: VWord l -> VFloat l -> MInt l + , bpFpToRational :: VFloat l -> EvalM l (VInt l, VInt l) + , bpFpToSBV :: Natural -> VWord l -> VFloat l -> MWord l -- Array operations , bpArrayConstant :: TValue l -> TValue l -> Value l -> MArray l , bpArrayLookup :: VArray l -> Value l -> MValue l @@ -364,6 +406,42 @@ constMap bp = Map.fromList , ("Prelude.rationalNeg", rationalNegOp bp) , ("Prelude.rationalRecip", rationalRecipOp) , ("Prelude.rationalFloor", rationalFloorOp bp) + -- Floats + , ("Prelude.Float", floatTypeOp) + , ("Prelude.fpAbs", fpAbsOp bp) + , ("Prelude.fpAdd", fpAddOp bp) + , ("Prelude.fpCast", fpCastOp bp) + , ("Prelude.fpDiv", fpDivOp bp) + , ("Prelude.fpFMA", fpFMAOp bp) + , ("Prelude.fpFromBits", fpFromBitsOp bp) + , ("Prelude.fpFromBV", fpFromBVOp bp) + , ("Prelude.fpFromInteger", fpFromIntegerOp bp) + , ("Prelude.fpFromRational", fpFromRationalOp bp) + , ("Prelude.fpFromSBV", fpFromSBVOp bp) + , ("Prelude.fpIeeeEq", fpIeeeEqOp bp) + , ("Prelude.fpIsInf", fpIsInfOp bp) + , ("Prelude.fpIsNaN", fpIsNaNOp bp) + , ("Prelude.fpIsNeg", fpIsNegOp bp) + , ("Prelude.fpIsNormal", fpIsNormalOp bp) + , ("Prelude.fpIsPos", fpIsPosOp bp) + , ("Prelude.fpIsSubnormal", fpIsSubnormalOp bp) + , ("Prelude.fpIsZero", fpIsZeroOp bp) + , ("Prelude.fpLt", fpLtOp bp) + , ("Prelude.fpLogicalEq", fpLogicalEqOp bp) + , ("Prelude.fpMul", fpMulOp bp) + , ("Prelude.fpNaN", fpNaNOp bp) + , ("Prelude.fpNeg", fpNegOp bp) + , ("Prelude.fpPosInf", fpPosInfOp bp) + , ("Prelude.fpPosZero", fpPosZeroOp bp) + , ("Prelude.fpRem", fpRemOp bp) + , ("Prelude.fpRound", fpRoundOp bp) + , ("Prelude.fpSqrt", fpSqrtOp bp) + , ("Prelude.fpSub", fpSubOp bp) + , ("Prelude.fpToBits", fpToBitsOp bp) + , ("Prelude.fpToBV", fpToBVOp bp) + , ("Prelude.fpToInteger", fpToIntegerOp bp) + , ("Prelude.fpToRational", fpToRationalOp bp) + , ("Prelude.fpToSBV", fpToSBVOp bp) -- Modular Integers , ("Prelude.IntMod", natFun $ \n -> PrimValue (TValue (VIntModType n))) -- Vectors @@ -1340,6 +1418,346 @@ intToNatOp = intFun $ \x -> PrimValue $! if x >= 0 then VNat (fromInteger x) else VNat 0 +-- primitive Float : Nat -> Nat -> sort 0; +floatTypeOp :: VMonad l => Prim l +floatTypeOp = + natFun $ \e -> + natFun $ \p -> + PrimValue (TValue (VFloatType e p)) + +-- primitive fpAbs : (e : Nat) -> (p : Nat) -> Float e p -> Float e p; +fpAbsOp :: VMonad l => BasePrims l -> Prim l +fpAbsOp bp = + constFun $ + constFun $ + floatFun $ \x -> + Prim $ + VFloat <$> bpFpAbs bp x + +-- primitive fpAdd : (e : Nat) -> (p : Nat) -> RoundingMode -> Float e p -> Float e p -> Float e p; +fpAddOp :: VMonad l => BasePrims l -> Prim l +fpAddOp bp = + constFun $ + constFun $ + wordFun (bpPack bp) $ \rm -> + floatFun $ \x -> + floatFun $ \y -> + Prim $ + VFloat <$> bpFpAdd bp rm x y + +-- primitive fpCast : (e1 : Nat) (p1 : Nat) (e2 : Nat) (p2 : Nat) -> RoundingMode -> Float e1 p1 -> Float e2 p2; +fpCastOp :: VMonad l => BasePrims l -> Prim l +fpCastOp bp = + constFun $ + constFun $ + natFun $ \e2 -> + natFun $ \p2 -> + wordFun (bpPack bp) $ \rm -> + floatFun $ \x -> + Prim $ + VFloat <$> bpFpCast bp e2 p2 rm x + +-- primitive fpDiv : (e : Nat) -> (p : Nat) -> RoundingMode -> Float e p -> Float e p -> Float e p; +fpDivOp :: VMonad l => BasePrims l -> Prim l +fpDivOp bp = + constFun $ + constFun $ + wordFun (bpPack bp) $ \rm -> + floatFun $ \x -> + floatFun $ \y -> + Prim $ + VFloat <$> bpFpDiv bp rm x y + +-- primitive fpFMA : (e : Nat) -> (p : Nat) -> RoundingMode -> Float e p -> Float e p -> Float e p -> Float e p; +fpFMAOp :: VMonad l => BasePrims l -> Prim l +fpFMAOp bp = + constFun $ + constFun $ + wordFun (bpPack bp) $ \rm -> + floatFun $ \x -> + floatFun $ \y -> + floatFun $ \z -> + Prim $ + VFloat <$> bpFpFMA bp rm x y z + +-- primitive fpFromBits : (e : Nat) -> (p : Nat) -> Vec (addNat e p) Bool -> Float e p; +fpFromBitsOp :: VMonad l => BasePrims l -> Prim l +fpFromBitsOp bp = + natFun $ \e -> + natFun $ \p -> + wordFun (bpPack bp) $ \x -> + Prim $ + VFloat <$> bpFpFromBits bp e p x + +-- primitive fpFromBV : (n : Nat) (e : Nat) -> (p : Nat) -> RoundingMode -> Vec (Succ n) Bool -> Float e p; +fpFromBVOp :: VMonad l => BasePrims l -> Prim l +fpFromBVOp bp = + constFun $ + natFun $ \e -> + natFun $ \p -> + wordFun (bpPack bp) $ \rm -> + wordFun (bpPack bp) $ \x -> + Prim $ + VFloat <$> bpFpFromBV bp e p rm x + +-- primitive fpFromInteger : (e : Nat) -> (p : Nat) -> RoundingMode -> Integer -> Float e p; +fpFromIntegerOp :: VMonad l => BasePrims l -> Prim l +fpFromIntegerOp bp = + natFun $ \e -> + natFun $ \p -> + wordFun (bpPack bp) $ \rm -> + intFun $ \x -> + Prim $ + VFloat <$> bpFpFromInteger bp e p rm x + +-- primitive fpFromRational : (e : Nat) -> (p : Nat) -> RoundingMode -> Rational -> Float e p; +fpFromRationalOp :: VMonad l => BasePrims l -> Prim l +fpFromRationalOp bp = + natFun $ \e -> + natFun $ \p -> + wordFun (bpPack bp) $ \rm -> + ratFun $ \(numer, denom) -> + Prim $ + VFloat <$> bpFpFromRational bp e p rm numer denom + +-- primitive fpFromSBV : (n : Nat) (e : Nat) -> (p : Nat) -> RoundingMode -> Vec (Succ n) Bool -> Float e p; +fpFromSBVOp :: VMonad l => BasePrims l -> Prim l +fpFromSBVOp bp = + constFun $ + natFun $ \e -> + natFun $ \p -> + wordFun (bpPack bp) $ \rm -> + wordFun (bpPack bp) $ \x -> + Prim $ + VFloat <$> bpFpFromSBV bp e p rm x + +-- primitive fpIeeeEq : (e : Nat) -> (p : Nat) -> Float e p -> Float e p -> Bool; +fpIeeeEqOp :: VMonad l => BasePrims l -> Prim l +fpIeeeEqOp bp = + constFun $ + constFun $ + floatFun $ \x -> + floatFun $ \y -> + Prim $ + VBool <$> bpFpIeeeEq bp x y + +-- primitive fpIsInf : (e : Nat) -> (p : Nat) -> Float e p -> Bool; +fpIsInfOp :: VMonad l => BasePrims l -> Prim l +fpIsInfOp bp = + constFun $ + constFun $ + floatFun $ \x -> + Prim $ + VBool <$> bpFpIsInf bp x + +-- primitive fpIsNaN : (e : Nat) -> (p : Nat) -> Float e p -> Bool; +fpIsNaNOp :: VMonad l => BasePrims l -> Prim l +fpIsNaNOp bp = + constFun $ + constFun $ + floatFun $ \x -> + Prim $ + VBool <$> bpFpIsNaN bp x + +-- primitive fpIsNeg : (e : Nat) -> (p : Nat) -> Float e p -> Bool; +fpIsNegOp :: VMonad l => BasePrims l -> Prim l +fpIsNegOp bp = + constFun $ + constFun $ + floatFun $ \x -> + Prim $ + VBool <$> bpFpIsNeg bp x + +-- primitive fpIsNormal : (e : Nat) -> (p : Nat) -> Float e p -> Bool; +fpIsNormalOp :: VMonad l => BasePrims l -> Prim l +fpIsNormalOp bp = + constFun $ + constFun $ + floatFun $ \x -> + Prim $ + VBool <$> bpFpIsNormal bp x + +-- primitive fpIsPos : (e : Nat) -> (p : Nat) -> Float e p -> Bool; +fpIsPosOp :: VMonad l => BasePrims l -> Prim l +fpIsPosOp bp = + constFun $ + constFun $ + floatFun $ \x -> + Prim $ + VBool <$> bpFpIsPos bp x + +-- primitive fpIsSubnormal : (e : Nat) -> (p : Nat) -> Float e p -> Bool; +fpIsSubnormalOp :: VMonad l => BasePrims l -> Prim l +fpIsSubnormalOp bp = + constFun $ + constFun $ + floatFun $ \x -> + Prim $ + VBool <$> bpFpIsSubnormal bp x + +-- primitive fpIsZero : (e : Nat) -> (p : Nat) -> Float e p -> Bool; +fpIsZeroOp :: VMonad l => BasePrims l -> Prim l +fpIsZeroOp bp = + constFun $ + constFun $ + floatFun $ \x -> + Prim $ + VBool <$> bpFpIsZero bp x + +-- primitive fpLt : (e : Nat) -> (p : Nat) -> Float e p -> Float e p -> Bool; +fpLtOp :: VMonad l => BasePrims l -> Prim l +fpLtOp bp = + constFun $ + constFun $ + floatFun $ \x -> + floatFun $ \y -> + Prim $ + VBool <$> bpFpLt bp x y + +-- primitive fpLogicalEq : (e : Nat) -> (p : Nat) -> Float e p -> Float e p -> Bool; +fpLogicalEqOp :: VMonad l => BasePrims l -> Prim l +fpLogicalEqOp bp = + constFun $ + constFun $ + floatFun $ \x -> + floatFun $ \y -> + Prim $ + VBool <$> bpFpLogicalEq bp x y + +-- primitive fpMul : (e : Nat) -> (p : Nat) -> RoundingMode -> Float e p -> Float e p -> Float e p; +fpMulOp :: VMonad l => BasePrims l -> Prim l +fpMulOp bp = + constFun $ + constFun $ + wordFun (bpPack bp) $ \rm -> + floatFun $ \x -> + floatFun $ \y -> + Prim $ + VFloat <$> bpFpMul bp rm x y + +-- primitive fpNaN : (e : Nat) -> (p : Nat) -> Float e p; +fpNaNOp :: VMonad l => BasePrims l -> Prim l +fpNaNOp bp = + natFun $ \e -> + natFun $ \p -> + Prim $ + VFloat <$> bpFpNaN bp e p + +-- primitive fpNeg : (e : Nat) -> (p : Nat) -> Float e p -> Float e p; +fpNegOp :: VMonad l => BasePrims l -> Prim l +fpNegOp bp = + constFun $ + constFun $ + floatFun $ \x -> + Prim $ + VFloat <$> bpFpNeg bp x + +-- primitive fpPosInf : (e : Nat) -> (p : Nat) -> Float e p; +fpPosInfOp :: VMonad l => BasePrims l -> Prim l +fpPosInfOp bp = + natFun $ \e -> + natFun $ \p -> + Prim $ + VFloat <$> bpFpPosInf bp e p + +-- primitive fpPosZero : (e : Nat) -> (p : Nat) -> Float e p; +fpPosZeroOp :: VMonad l => BasePrims l -> Prim l +fpPosZeroOp bp = + natFun $ \e -> + natFun $ \p -> + Prim $ + VFloat <$> bpFpPosZero bp e p + +-- primitive fpRem : (e : Nat) -> (p : Nat) -> Float e p -> Float e p -> Float e p; +fpRemOp :: VMonad l => BasePrims l -> Prim l +fpRemOp bp = + constFun $ + constFun $ + floatFun $ \x -> + floatFun $ \y -> + Prim $ + VFloat <$> bpFpRem bp x y + +-- primitive fpRound : (e : Nat) -> (p : Nat) -> RoundingMode -> Float e p -> Float e p; +fpRoundOp :: VMonad l => BasePrims l -> Prim l +fpRoundOp bp = + wordFun (bpPack bp) $ \rm -> + floatFun $ \x -> + Prim $ + VFloat <$> bpFpRound bp rm x + +-- primitive fpSqrt : (e : Nat) -> (p : Nat) -> RoundingMode -> Float e p -> Float e p; +fpSqrtOp :: VMonad l => BasePrims l -> Prim l +fpSqrtOp bp = + constFun $ + constFun $ + wordFun (bpPack bp) $ \rm -> + floatFun $ \x -> + Prim $ + VFloat <$> bpFpSqrt bp rm x + +-- primitive fpSub : (e : Nat) -> (p : Nat) -> RoundingMode -> Float e p -> Float e p -> Float e p; +fpSubOp :: VMonad l => BasePrims l -> Prim l +fpSubOp bp = + constFun $ + constFun $ + wordFun (bpPack bp) $ \rm -> + floatFun $ \x -> + floatFun $ \y -> + Prim $ + VFloat <$> bpFpSub bp rm x y + +-- primitive fpToBits : (e : Nat) -> (p : Nat) -> Float e p -> Vec (addNat e p) Bool; +fpToBitsOp :: VMonad l => BasePrims l -> Prim l +fpToBitsOp bp = + constFun $ + constFun $ + floatFun $ \x -> + Prim $ + VWord <$> bpFpToBits bp x + +-- primitive fpToBV : (n : Nat) (e : Nat) -> (p : Nat) -> RoundingMode -> Float e p -> Vec (Succ n) Bool; +fpToBVOp :: VMonad l => BasePrims l -> Prim l +fpToBVOp bp = + natFun $ \n -> + constFun $ + constFun $ + wordFun (bpPack bp) $ \rm -> + floatFun $ \x -> + Prim $ + VWord <$> bpFpToBV bp n rm x + +-- primitive fpToInteger : (e : Nat) -> (p : Nat) -> RoundingMode -> Float e p -> Integer; +fpToIntegerOp :: VMonad l => BasePrims l -> Prim l +fpToIntegerOp bp = + constFun $ + constFun $ + wordFun (bpPack bp) $ \rm -> + floatFun $ \x -> + Prim $ + VInt <$> bpFpToInteger bp rm x + +-- primitive fpToRational : (e : Nat) -> (p : Nat) -> Float e p -> Rational; +fpToRationalOp :: VMonad l => BasePrims l -> Prim l +fpToRationalOp bp = + constFun $ + constFun $ + floatFun $ \x -> + Prim $ do + (numer, denom) <- bpFpToRational bp x + pure $ VRational numer denom + +-- primitive fpToSBV : (n : Nat) (e : Nat) -> (p : Nat) -> RoundingMode -> Float e p -> Vec (Succ n) Bool; +fpToSBVOp :: VMonad l => BasePrims l -> Prim l +fpToSBVOp bp = + natFun $ \n -> + constFun $ + constFun $ + wordFun (bpPack bp) $ \rm -> + floatFun $ \x -> + Prim $ + VWord <$> bpFpToSBV bp n rm x + -- primitive ratio : Integer -> Integer -> Rational; ratioOp :: VMonad l => Prim l ratioOp = @@ -1568,6 +1986,8 @@ muxValue bp b x0 y0 = value x0 y0 value (VRational xNumer xDenom) (VRational yNumer yDenom) = VRational <$> bpMuxInt bp b xNumer yNumer <*> bpMuxInt bp b xDenom yDenom + value (VFloat x) (VFloat y) = VFloat <$> bpMuxFloat bp b x y + value x@(VWord _) y = do xv <- toVector' x value (VVector xv) y value x y@(VWord _) = do yv <- toVector' y diff --git a/saw-core/src/SAWCore/Simulator/RME.hs b/saw-core/src/SAWCore/Simulator/RME.hs index e33310a8dd..41eeb74def 100644 --- a/saw-core/src/SAWCore/Simulator/RME.hs +++ b/saw-core/src/SAWCore/Simulator/RME.hs @@ -77,6 +77,7 @@ type instance EvalM ReedMuller = Identity type instance VBool ReedMuller = RME type instance VWord ReedMuller = Vector RME type instance VInt ReedMuller = Integer +type instance VFloat ReedMuller = () type instance VArray ReedMuller = () type instance Extra ReedMuller = RExtra @@ -160,6 +161,7 @@ prims = , Prims.bpMuxBool = pure3 RME.mux , Prims.bpMuxWord = pure3 muxRMEV , Prims.bpMuxInt = pure3 muxInt + , Prims.bpMuxFloat = unsupportedRMEPrimitive "bpMuxFloat" , Prims.bpMuxArray = unsupportedRMEPrimitive "bpMuxArray" , Prims.bpMuxExtra = pure3 muxExtra -- Booleans @@ -223,6 +225,41 @@ prims = , Prims.bpIntMin = pure2 min , Prims.bpIntMax = pure2 max , Prims.bpNatToInt = pure1 toInteger + -- Float operations + , Prims.bpFpAbs = unsupportedRMEPrimitive "bpFpAbs" + , Prims.bpFpAdd = unsupportedRMEPrimitive "bpFpAdd" + , Prims.bpFpCast = unsupportedRMEPrimitive "bpFpCast" + , Prims.bpFpDiv = unsupportedRMEPrimitive "bpFpDiv" + , Prims.bpFpFMA = unsupportedRMEPrimitive "bpFpFMA" + , Prims.bpFpFromBits = unsupportedRMEPrimitive "bpFpFromBits" + , Prims.bpFpFromBV = unsupportedRMEPrimitive "bpFpFromBV" + , Prims.bpFpFromInteger = unsupportedRMEPrimitive "bpFpFromInteger" + , Prims.bpFpFromRational = unsupportedRMEPrimitive "bpFpFromRational" + , Prims.bpFpFromSBV = unsupportedRMEPrimitive "bpFpFromSBV" + , Prims.bpFpIeeeEq = unsupportedRMEPrimitive "bpFpIeeeEq" + , Prims.bpFpIsInf = unsupportedRMEPrimitive "bpFpIsInf" + , Prims.bpFpIsNaN = unsupportedRMEPrimitive "bpFpIsNaN" + , Prims.bpFpIsNeg = unsupportedRMEPrimitive "bpFpIsNeg" + , Prims.bpFpIsNormal = unsupportedRMEPrimitive "bpFpIsNormal" + , Prims.bpFpIsPos = unsupportedRMEPrimitive "bpFpIsPos" + , Prims.bpFpIsSubnormal = unsupportedRMEPrimitive "bpFpIsSubnormal" + , Prims.bpFpIsZero = unsupportedRMEPrimitive "bpFpIsZero" + , Prims.bpFpLt = unsupportedRMEPrimitive "bpFpLt" + , Prims.bpFpLogicalEq = unsupportedRMEPrimitive "bpFpLogicalEq" + , Prims.bpFpMul = unsupportedRMEPrimitive "bpFpMul" + , Prims.bpFpNaN = unsupportedRMEPrimitive "bpFpNaN" + , Prims.bpFpNeg = unsupportedRMEPrimitive "bpFpNeg" + , Prims.bpFpPosInf = unsupportedRMEPrimitive "bpFpPosInf" + , Prims.bpFpPosZero = unsupportedRMEPrimitive "bpFpPosZero" + , Prims.bpFpRem = unsupportedRMEPrimitive "bpFpRem" + , Prims.bpFpRound = unsupportedRMEPrimitive "bpFpRound" + , Prims.bpFpSqrt = unsupportedRMEPrimitive "bpFpSqrt" + , Prims.bpFpSub = unsupportedRMEPrimitive "bpFpSub" + , Prims.bpFpToBits = unsupportedRMEPrimitive "bpFpToBits" + , Prims.bpFpToBV = unsupportedRMEPrimitive "bpFpToBV" + , Prims.bpFpToInteger = unsupportedRMEPrimitive "bpFpToInteger" + , Prims.bpFpToRational = unsupportedRMEPrimitive "bpFpToRational" + , Prims.bpFpToSBV = unsupportedRMEPrimitive "bpFpToSBV" -- Array operations , Prims.bpArrayConstant = unsupportedRMEPrimitive "bpArrayConstant" , Prims.bpArrayLookup = unsupportedRMEPrimitive "bpArrayLookup" diff --git a/saw-core/src/SAWCore/Simulator/Value.hs b/saw-core/src/SAWCore/Simulator/Value.hs index 45db587bec..0f8c6f495d 100644 --- a/saw-core/src/SAWCore/Simulator/Value.hs +++ b/saw-core/src/SAWCore/Simulator/Value.hs @@ -26,8 +26,10 @@ module SAWCore.Simulator.Value , VBool , VWord , VInt + , VFloat , VArray , Extra + , VRoundingMode , WithM -- * Type synonyms , Thunk @@ -35,6 +37,7 @@ module SAWCore.Simulator.Value , MBool , MWord , MInt + , MFloat , MArray , VMonad , VMonadLazy @@ -126,6 +129,7 @@ data Value l -- ^ A rational number, where the first 'VInt' is the numerator and the -- second 'VInt' is the denominator. -- Invariant: the denominator is non-zero. + | VFloat (VFloat l) | VArray (VArray l) | VString !Text | VExtra (Extra l) @@ -148,6 +152,9 @@ data TValue l | VIntType | VIntModType !Natural | VRationalType + | VFloatType !Natural !Natural + -- ^ The first 'Natural' is the exponent size, and the second 'Natural' is + -- the precision size (both in bits). | VArrayType !(TValue l) !(TValue l) | VPiType !(TValue l) !(PiBody l) | VStringType @@ -169,11 +176,16 @@ type family VBool l :: Type type family VWord l :: Type -- | Integers for value instantiation 'l' type family VInt l :: Type +-- | Floats for value instantiation 'l' +type family VFloat l :: Type -- | SMT arrays for value instantiation 'l' type family VArray l :: Type -- | Additional constructors for instantiation 'l' type family Extra l :: Type +-- | SAWCore encodes rounding modes as 3-bit words. +type VRoundingMode l = VWord l + -- | Short-hand for a monadic value. type MValue l = EvalM l (Value l) @@ -186,6 +198,9 @@ type MWord l = EvalM l (VWord l) -- | Short-hand for a monadic integer. type MInt l = EvalM l (VInt l) +-- | Short-hand for a monadic float. +type MFloat l = EvalM l (VFloat l) + -- | Short-hand for a monadic array. type MArray l = EvalM l (VArray l) @@ -204,6 +219,7 @@ type instance EvalM (WithM m l) = m type instance VBool (WithM m l) = VBool l type instance VWord (WithM m l) = VWord l type instance VInt (WithM m l) = VInt l +type instance VFloat (WithM m l) = VFloat l type instance VArray (WithM m l) = VArray l type instance Extra (WithM m l) = Extra l @@ -224,6 +240,7 @@ instance Show (Extra l) => Show (Value l) where VInt _ -> showString "<>" VIntMod n _ -> showString ("<>") VRational{} -> showString "<>" + VFloat{} -> showString "<>" VArray{} -> showString "<>" VString s -> shows s VExtra x -> showsPrec p x @@ -239,6 +256,8 @@ instance Show (Extra l) => Show (TValue l) where VIntType -> showString "Integer" VIntModType n -> showParen True (showString "IntMod " . shows n) VRationalType -> showString "Rational" + VFloatType e' p' -> + showParen True (showString "Float " . shows e' . showChar ' ' . shows p') VArrayType{} -> showString "Array" VPiType t _ -> showParen True (shows t . showString " -> ...") @@ -377,6 +396,7 @@ asFiniteTypeTValue v = VIntType -> Nothing VIntModType{} -> Nothing VRationalType{} -> Nothing + VFloatType{} -> Nothing VArrayType{} -> Nothing asFirstOrderTypeValue :: Value l -> Maybe FirstOrderType @@ -393,6 +413,7 @@ asFirstOrderTypeTValue v = VIntType -> return FOTInt VIntModType m -> return (FOTIntMod m) VRationalType -> return FOTRational + VFloatType e p -> pure (FOTFloat e p) VArrayType a b -> FOTArray <$> asFirstOrderTypeTValue a <*> asFirstOrderTypeTValue b VDataType (ModuleIdentifier "Prelude.UnitType") [] [] -> @@ -444,6 +465,7 @@ suffixTValue tv = VIntType -> Just "_Int" VIntModType n -> Just ("_IntMod_" ++ show n) VRationalType -> Just "_Rational" + VFloatType e p -> Just ("_Float_" ++ show e ++ "_" ++ show p) VArrayType a b -> do a' <- suffixTValue a b' <- suffixTValue b diff --git a/saw-core/src/SAWCore/Testing/Random.hs b/saw-core/src/SAWCore/Testing/Random.hs index b0bd83827d..3df987ff08 100644 --- a/saw-core/src/SAWCore/Testing/Random.hs +++ b/saw-core/src/SAWCore/Testing/Random.hs @@ -1,4 +1,7 @@ {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} -- | -- Module : SAWCore.Testing.Random @@ -18,8 +21,11 @@ module SAWCore.Testing.Random ( ) where import SAWCore.FiniteValue - ( FirstOrderType(..), FirstOrderValue(..), scFirstOrderValue ) + ( FirstOrderFloat(..), FirstOrderType(..), FirstOrderValue(..) + , scFirstOrderValue + ) +import SAWCore.FloatHelpers (fpOpts) import SAWCore.Module (ModuleMap) import SAWCore.Name (VarName(..)) import SAWCore.SATQuery @@ -32,12 +38,15 @@ import SAWCore.Simulator.Value (Value(..)) -- , TValue(..)) import qualified Control.Monad.Fail as F import Control.Monad.Random +import Data.Bits (Bits(..)) import Data.Functor.Compose (Compose(..)) import qualified Data.IntMap as IntMap import qualified Data.Map as Map import Data.Map (Map) import Data.Ratio ((%)) import qualified Data.Set as Set +import LibBF +import Numeric.Natural (Natural) import System.Random.TF (newTFGen, TFGen) @@ -52,6 +61,8 @@ randomFirstOrderValue (FOTIntMod m) = Compose (Just (FOVIntMod m <$> getRandomR (0, toInteger m - 1))) randomFirstOrderValue FOTRational = Compose (Just (FOVRational <$> randomRational)) +randomFirstOrderValue (FOTFloat e p) = + Compose (Just ((FOVFloat . FirstOrderFloat e p) <$> randomBigFloat e p)) randomFirstOrderValue (FOTVec n FOTBit) = Compose (Just (FOVWord n <$> getRandomR (0, 2^n - 1))) randomFirstOrderValue (FOTVec n t) = @@ -73,7 +84,63 @@ randomRational = do denom <- getRandomR (1, 10^(6 :: Int)) pure (numer % denom) - +randomBigFloat :: + forall m. + MonadRandom m => + -- | Exponent width + Natural -> + -- | Precision width + Natural -> + m BigFloat +randomBigFloat e p = do + let sz :: Integer + sz = 5 + x <- getRandomR (0, 10*(sz+1)) + if | x < 2 -> pure bfNaN + | x < 4 -> pure bfPosInf + | x < 6 -> pure bfNegInf + | x < 8 -> pure bfPosZero + | x < 10 -> pure bfNegZero + | x <= sz -> randomSubnormal -- about 10% of the time + | x <= 4*(sz+1) -> randomBinary -- about 40% + | otherwise -> randomNormal -- remaining ~50% + where + opts = fpOpts e p NearEven + + eInt = fromIntegral @Natural @Int e + pInt = fromIntegral @Natural @Int p + + -- Generates floats uniformly chosen from among all bitpatterns. + randomBinary :: m BigFloat + randomBinary = do + -- NB: Use the size (e+p) below: 1 bit for the sign bit, e bits for the + -- exponent, and (p - 1) bits for the mantissa for a total of + -- (1 + e + (p - 1)) = (e+p) bits. + v <- getRandomR (0, bit (eInt+pInt) - 1) + pure $ bfFromBits opts v + + -- Generates floats corresponding to subnormal values. These are values + -- with 0 biased exponent and nonzero mantissa. + randomSubnormal :: m BigFloat + randomSubnormal = do + sgn <- getRandom + -- NB: Use size (p - 1) bits below. `p` includes the implicit leading bit + -- of the mantissa, which isn't explicitly included in the overall bit + -- pattern. + v <- getRandomR (1, bit (pInt - 1) - 1) + let bf = bfFromBits opts v + pure $ if sgn then bfNeg bf else bf + + -- Generates floats corresponding to normal values. These are values where + -- the exponent bits are not all zeros and not all ones. + randomNormal :: m BigFloat + randomNormal = do + sgn <- getRandom + ex <- getRandomR (1, bit eInt - 2) + si <- getRandomR (0, bit (pInt - 1) - 1) + let v = (ex `shiftL` (pInt - 1)) .|. si + let bf = bfFromBits opts v + pure $ if sgn then bfNeg bf else bf execTest :: (F.MonadFail m, MonadRandom m, MonadIO m) => diff --git a/saw-server/src/SAWServer/ProofScript.hs b/saw-server/src/SAWServer/ProofScript.hs index a7ff2f2126..97a206fc8a 100644 --- a/saw-server/src/SAWServer/ProofScript.hs +++ b/saw-server/src/SAWServer/ProofScript.hs @@ -241,6 +241,7 @@ exportFirstOrderExpression fv = FOVInt i -> return $ Integer i FOVIntMod m i -> return $ IntegerModulo i (toInteger m) FOVRational _r -> Left "exportFirstOrderExpression: unsupported type: Rational" + FOVFloat{} -> Left "exportFirstOrderExpression: unsupported type: Float" FOVWord w x -> return $ Num Hex (pack (showHex x "")) (toInteger w) FOVVec _t vs -> Sequence <$> mapM exportFirstOrderExpression vs FOVArray{} -> Left "exportFirstOrderExpression: unsupported type: Array (concrete case)" diff --git a/saw.cabal b/saw.cabal index 4bc6d40e9b..4acb61a6fe 100644 --- a/saw.cabal +++ b/saw.cabal @@ -148,6 +148,9 @@ library saw-core utf8-string, vector, + -- galois packages from hackage + libBF, + -- packages in git submodules parameterized-utils, rme, @@ -163,6 +166,7 @@ library saw-core SAWCore.Conversion SAWCore.Cache SAWCore.FiniteValue + SAWCore.FloatHelpers SAWCore.Module SAWCore.Name SAWCore.Parser.AST