From 9b91107cdc820c5743f1ea823cc4fbfd47f833dc Mon Sep 17 00:00:00 2001 From: Eddy Westbrook Date: Wed, 28 Jul 2021 12:27:25 -0700 Subject: [PATCH 01/28] added ppInfoAddTypedExprNames to use a base name for each variable depending on its type; also removed old PPInfo-related code --- .../src/Verifier/SAW/Heapster/Implication.hs | 2 +- .../src/Verifier/SAW/Heapster/Permissions.hs | 105 +++++++++--------- .../Verifier/SAW/Heapster/TypedCrucible.hs | 21 ++-- 3 files changed, 63 insertions(+), 65 deletions(-) diff --git a/heapster-saw/src/Verifier/SAW/Heapster/Implication.hs b/heapster-saw/src/Verifier/SAW/Heapster/Implication.hs index d648b68b75..e2c5a36363 100644 --- a/heapster-saw/src/Verifier/SAW/Heapster/Implication.hs +++ b/heapster-saw/src/Verifier/SAW/Heapster/Implication.hs @@ -2958,7 +2958,7 @@ implApplyImpl1 impl1 mb_ms = (helper mbperms args) (gopenBinding strongMbM mbperm >>>= \(ns, perms') -> gmodify (set implStatePerms perms' . - over implStatePPInfo (ppInfoAddExprNames "z" ns)) >>> + over implStatePPInfo (ppInfoAddTypedExprNames ctx ns)) >>> implSetNameTypes ns ctx >>> f ns) diff --git a/heapster-saw/src/Verifier/SAW/Heapster/Permissions.hs b/heapster-saw/src/Verifier/SAW/Heapster/Permissions.hs index 5a43e27973..086912c3c0 100644 --- a/heapster-saw/src/Verifier/SAW/Heapster/Permissions.hs +++ b/heapster-saw/src/Verifier/SAW/Heapster/Permissions.hs @@ -29,6 +29,7 @@ module Verifier.SAW.Heapster.Permissions where import Prelude hiding (pred) +import Data.Char (isDigit) import Data.Maybe import Data.List hiding (sort) import Data.List.NonEmpty (NonEmpty(..)) @@ -41,6 +42,8 @@ import Data.BitVector.Sized (BV) import Numeric.Natural import GHC.TypeLits import Data.Kind +import Data.Map.Strict (Map) +import qualified Data.Map.Strict as Map import Control.Applicative hiding (empty) import Control.Monad.Identity hiding (ap) import Control.Monad.State hiding (ap) @@ -134,41 +137,65 @@ foldMapWithDefault comb def f l = foldr1WithDefault comb def $ map f l newtype StringF a = StringF { unStringF :: String } +-- | Convert a type to a base name for printing variables of that type +typeBaseName :: TypeRepr a -> String +typeBaseName UnitRepr = "u" +typeBaseName BoolRepr = "b" +typeBaseName NatRepr = "n" +typeBaseName (BVRepr _) = "bv" +typeBaseName (LLVMPointerRepr _) = "ptr" +typeBaseName (LLVMBlockRepr _) = "blk" +typeBaseName (LLVMFrameRepr _) = "frm" +typeBaseName LifetimeRepr = "l" +typeBaseName RWModalityRepr = "rw" +typeBaseName (ValuePermRepr _) = "perm" +typeBaseName (LLVMShapeRepr _) = "shape" +typeBaseName (StringRepr _) = "str" +typeBaseName (FunctionHandleRepr _ _) = "fn" +typeBaseName (StructRepr _) = "strct" +typeBaseName _ = "x" + + +-- | A 'PPInfo' maps bound 'Name's to strings used for printing, with the +-- invariant that each 'Name' is mapped to a different string. This invariant is +-- maintained by always assigning each 'Name' to a "base string", which is often +-- determined by the Crucible type of the 'Name', followed by a unique +-- integer. Note that this means no base name should end with an integer. To +-- ensure the uniqueness of these integers, the 'PPInfo' structure tracks the +-- next integer to be used for each base string. data PPInfo = PPInfo { ppExprNames :: NameMap (StringF :: CrucibleType -> Type), - ppPermNames :: NameMap (StringF :: Type -> Type), - ppVarIndex :: Int } + ppBaseNextInt :: Map String Int } +-- | Build an empty 'PPInfo' structure emptyPPInfo :: PPInfo -emptyPPInfo = PPInfo NameMap.empty NameMap.empty 1 +emptyPPInfo = PPInfo NameMap.empty Map.empty --- | Record an expression variable in a 'PPInfo' with the given base name +-- | Add an expression variable to a 'PPInfo' with the given base name ppInfoAddExprName :: String -> ExprVar a -> PPInfo -> PPInfo -ppInfoAddExprName base x info = - info { ppExprNames = - NameMap.insert x (StringF (base ++ show (ppVarIndex info))) - (ppExprNames info), - ppVarIndex = ppVarIndex info + 1 } - +ppInfoAddExprName base _ _ + | length base == 0 || isDigit (last base) = + error ("ppInfoAddExprName: invalid base name: " ++ base) +ppInfoAddExprName base x (PPInfo { .. }) = + let (i',str) = + case Map.lookup base ppBaseNextInt of + Just i -> (i+1,str ++ show i) + Nothing -> (1,str) in + PPInfo { ppExprNames = NameMap.insert x (StringF str) ppExprNames, + ppBaseNextInt = Map.insert base i' ppBaseNextInt } + +-- | Add a sequence of variables to a 'PPInfo' with the given base name ppInfoAddExprNames :: String -> RAssign Name (tps :: RList CrucibleType) -> PPInfo -> PPInfo ppInfoAddExprNames _ MNil info = info ppInfoAddExprNames base (ns :>: n) info = ppInfoAddExprNames base ns $ ppInfoAddExprName base n info --- | Record a permission variable in a 'PPInfo' with the given base name -ppInfoAddPermName :: String -> Name (a :: Type) -> PPInfo -> PPInfo -ppInfoAddPermName base x info = - info { ppPermNames = - NameMap.insert x (StringF (base ++ show (ppVarIndex info))) - (ppPermNames info), - ppVarIndex = ppVarIndex info + 1 } - -ppInfoAddPermNames :: String -> RAssign Name (tps :: RList Type) -> - PPInfo -> PPInfo -ppInfoAddPermNames _ MNil info = info -ppInfoAddPermNames base (ns :>: n) info = - ppInfoAddPermNames base ns $ ppInfoAddPermName base n info +-- | Add a sequence of variables to a 'PPInfo' using their 'typeBaseName's +ppInfoAddTypedExprNames :: CruCtx tps -> RAssign Name tps -> PPInfo -> PPInfo +ppInfoAddTypedExprNames _ MNil info = info +ppInfoAddTypedExprNames (CruCtxCons tps tp) (ns :>: n) info = + ppInfoAddTypedExprNames tps ns $ ppInfoAddExprName (typeBaseName tp) n info type PermPPM = Reader PPInfo @@ -235,19 +262,9 @@ instance PermPretty (ExprVar a) where instance PermPrettyF (Name :: CrucibleType -> Type) where permPrettyMF = permPrettyM -instance PermPretty (Name (a :: Type)) where - permPrettyM x = - do maybe_str <- NameMap.lookup x <$> ppPermNames <$> ask - case maybe_str of - Just (StringF str) -> return $ pretty str - Nothing -> return $ pretty (show x) - instance PermPretty (SomeName CrucibleType) where permPrettyM (SomeName x) = permPrettyM x -instance PermPretty (SomeName Type) where - permPrettyM (SomeName x) = permPrettyM x - instance PermPrettyF f => PermPretty (RAssign f ctx) where permPrettyM xs = ppCommaSep <$> sequence (RL.mapToList permPrettyMF xs) @@ -302,32 +319,12 @@ permPrettyExprMb f mb = do docs <- traverseRAssign (\n -> Constant <$> permPrettyM n) ns f docs $ permPrettyM a --- FIXME: no longer needed? -{- -permPrettyPermMb :: PermPretty a => - (RAssign (Constant (Doc ann)) ctx -> PermPPM (Doc ann) -> PermPPM (Doc ann)) -> - Mb (ctx :: RList Type) a -> PermPPM (Doc ann) -permPrettyPermMb f mb = - fmap mbLift $ strongMbM $ flip nuMultiWithElim1 mb $ \ns a -> - local (ppInfoAddPermNames "z" ns) $ - do docs <- traverseRAssign (\n -> Constant <$> permPrettyM n) ns - f docs $ permPrettyM a --} - instance PermPretty a => PermPretty (Mb (ctx :: RList CrucibleType) a) where permPrettyM = permPrettyExprMb $ \docs ppm -> (\pp -> PP.group (ppEncList True (RL.toList docs) <> nest 2 (dot <> line <> pp))) <$> ppm --- FIXME: no longer needed? -{- -instance PermPretty a => PermPretty (Mb (ctx :: RList Type) a) where - permPrettyM = - permPrettyPermMb $ \docs ppm -> - (\pp -> PP.group (tupled (RL.toList docs) <> dot <> line <> pp)) <$> ppm --} - instance PermPretty Integer where permPrettyM = return . pretty @@ -2686,7 +2683,7 @@ instance PermPretty (FunPerm ghosts args ret) where RL.split Proxy (cruCtxProxies args) ghosts_args_ns in local (ppInfoAddExprName "ret" ret_n) $ local (ppInfoAddExprNames "arg" args_ns) $ - local (ppInfoAddExprNames "ghost" ghosts_ns) $ + local (ppInfoAddTypedExprNames ghosts ghosts_ns) $ do pp_ps_in <- permPrettyM ps_in pp_ps_out <- permPrettyM ps_out pp_ghosts <- permPrettyM (RL.map2 VarAndType ghosts_ns $ diff --git a/heapster-saw/src/Verifier/SAW/Heapster/TypedCrucible.hs b/heapster-saw/src/Verifier/SAW/Heapster/TypedCrucible.hs index 3a48529668..936f54d7e1 100644 --- a/heapster-saw/src/Verifier/SAW/Heapster/TypedCrucible.hs +++ b/heapster-saw/src/Verifier/SAW/Heapster/TypedCrucible.hs @@ -1923,9 +1923,9 @@ runPermCheckM names entryID args ghosts mb_perms_in m = let go x = runGenStateContT x st (\_ () -> pure ()) in go $ - setVarTypes "top" (noNames' stTopCtx) tops_ns stTopCtx >>> - setVarTypes "local" arg_names args_ns args >>> - setVarTypes "ghost" (noNames' ghosts) ghosts_ns ghosts >>> + setVarTypes (Just "top") (noNames' stTopCtx) tops_ns stTopCtx >>> + setVarTypes (Just "local") arg_names args_ns args >>> + setVarTypes (Just "ghost") (noNames' ghosts) ghosts_ns ghosts >>> setInputExtState knownRepr ghosts ghosts_ns >>> m tops_ns args_ns ghosts_ns perms_in @@ -2177,16 +2177,17 @@ getVarTypes (xs :>: x) = CruCtxCons <$> getVarTypes xs <*> getVarType x -- | Remember the type of a free variable, and ensure that it has a permission setVarType :: - String -> + Maybe String -> Maybe String -> ExprVar a -> TypeRepr a -> PermCheckM ext cblocks blocks tops ret r ps r ps () -setVarType str dbg x tp = +setVarType maybe_str dbg x tp = let str' = - case dbg of - Nothing -> str - Just d -> "C[" ++ d ++ "]" + case (maybe_str,dbg) of + (_,Just d) -> "C[" ++ d ++ "]" + (Just str,_) -> str + (Nothing,Nothing) -> typeBaseName tp in modify $ \st -> st { stCurPerms = initVarPerm x (stCurPerms st), @@ -2195,7 +2196,7 @@ setVarType str dbg x tp = -- | Remember the types of a sequence of free variables setVarTypes :: - String -> + Maybe String -> RAssign (Constant (Maybe String)) tps -> RAssign Name tps -> CruCtx tps -> @@ -2530,7 +2531,7 @@ emitStmt tps names loc stmt = gopenBinding ((TypedConsStmt loc stmt (cruCtxProxies tps) <$>) . strongMbM) (mbPure (cruCtxProxies tps) ()) >>>= \(ns, ()) -> - setVarTypes "x" names ns tps >>> + setVarTypes Nothing names ns tps >>> gmodify (modifySTCurPerms (applyTypedStmt stmt ns)) >>> pure ns From 7b2b709292221c25d2887a439308882004664b39 Mon Sep 17 00:00:00 2001 From: Eddy Westbrook Date: Wed, 28 Jul 2021 12:35:58 -0700 Subject: [PATCH 02/28] whoops, fixed an infinite loop --- heapster-saw/src/Verifier/SAW/Heapster/Permissions.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/heapster-saw/src/Verifier/SAW/Heapster/Permissions.hs b/heapster-saw/src/Verifier/SAW/Heapster/Permissions.hs index 086912c3c0..b33ce4e0ff 100644 --- a/heapster-saw/src/Verifier/SAW/Heapster/Permissions.hs +++ b/heapster-saw/src/Verifier/SAW/Heapster/Permissions.hs @@ -179,8 +179,8 @@ ppInfoAddExprName base _ _ ppInfoAddExprName base x (PPInfo { .. }) = let (i',str) = case Map.lookup base ppBaseNextInt of - Just i -> (i+1,str ++ show i) - Nothing -> (1,str) in + Just i -> (i+1, base ++ show i) + Nothing -> (1, base) in PPInfo { ppExprNames = NameMap.insert x (StringF str) ppExprNames, ppBaseNextInt = Map.insert base i' ppBaseNextInt } From 6af2bd56278d6b1996d8ecfb661456d1072eef0e Mon Sep 17 00:00:00 2001 From: Eddy Westbrook Date: Wed, 28 Jul 2021 14:51:58 -0700 Subject: [PATCH 03/28] implemented lifetime subsumption --- .../src/Verifier/SAW/Heapster/Implication.hs | 54 +++++++++++++++---- 1 file changed, 45 insertions(+), 9 deletions(-) diff --git a/heapster-saw/src/Verifier/SAW/Heapster/Implication.hs b/heapster-saw/src/Verifier/SAW/Heapster/Implication.hs index e2c5a36363..60c9fa3d21 100644 --- a/heapster-saw/src/Verifier/SAW/Heapster/Implication.hs +++ b/heapster-saw/src/Verifier/SAW/Heapster/Implication.hs @@ -3026,20 +3026,21 @@ implCatchM m1 m2 = -- | "Push" all of the permissions in the permission set for a variable, which -- should be equal to the supplied permission, after deleting those permissions -- from the input permission set. This is like a simple "proof" of @x:p@. -implPushM :: NuMatchingAny1 r => ExprVar a -> ValuePerm a -> +implPushM :: HasCallStack => NuMatchingAny1 r => ExprVar a -> ValuePerm a -> ImplM vars s r (ps :> a) ps () implPushM x p = implApplyImpl1 (Impl1_Push x p) (MNil :>: Impl1Cont (const $ pure ())) -- | Call 'implPushM' for multiple @x:p@ permissions -implPushMultiM :: NuMatchingAny1 r => DistPerms ps -> ImplM vars s r ps RNil () +implPushMultiM :: HasCallStack => NuMatchingAny1 r => + DistPerms ps -> ImplM vars s r ps RNil () implPushMultiM DistPermsNil = pure () implPushMultiM (DistPermsCons ps x p) = implPushMultiM ps >>> implPushM x p -- | For each permission @x:p@ in a list of permissions, either prove @x:eq(x)@ -- by reflexivity if @p=eq(x)@ or push @x:p@ if @x@ has permissions @p@ -implPushOrReflMultiM :: NuMatchingAny1 r => DistPerms ps -> +implPushOrReflMultiM :: HasCallStack => NuMatchingAny1 r => DistPerms ps -> ImplM vars s r ps RNil () implPushOrReflMultiM DistPermsNil = pure () implPushOrReflMultiM (DistPermsCons ps x (ValPerm_Eq (PExpr_Var x'))) @@ -3050,7 +3051,7 @@ implPushOrReflMultiM (DistPermsCons ps x p) = -- | Pop a permission from the top of the stack back to the primary permission -- for a variable, assuming that the primary permission for that variable is -- empty, i.e., is the @true@ permission -implPopM :: NuMatchingAny1 r => ExprVar a -> ValuePerm a -> +implPopM :: HasCallStack => NuMatchingAny1 r => ExprVar a -> ValuePerm a -> ImplM vars s r ps (ps :> a) () implPopM x p = implApplyImpl1 (Impl1_Pop x p) (MNil :>: Impl1Cont (const $ pure ())) @@ -3723,6 +3724,28 @@ implSplitLifetimeM x f args l l2 ps_in ps_out = implSimplM Proxy (SImpl_SplitLifetime x f args l l2 ps_in ps_out) >>> getTopDistPerm l2 >>>= implPopM l2 + +-- | Subsume a smaller lifetime @l2@ inside a bigger lifetime @l1@, by putting +-- the @lowned@ permission for @l1@ inside that of @l2@. Assume permissions +-- +-- > l1:lowned (ps_in1 -o ps_out1) * l2:lowned (ps_in2 -o ps_out2) +-- +-- are on top of the stack, and change the permissions on @l2@ to +-- +-- > l2:lowned (ps_in2 -o l1:lowned (ps_in1 -o ps_out1),ps_out2) +-- +-- which is popped off the stack, leaving @l1:[l2]lcurrent@ on the stack. +implSubsumeLifetimeM :: NuMatchingAny1 r => ExprVar LifetimeType -> + LOwnedPerms ps_in1 -> LOwnedPerms ps_out1 -> + ExprVar LifetimeType -> + LOwnedPerms ps_in2 -> LOwnedPerms ps_out2 -> + ImplM vars s r (ps :> LifetimeType) + (ps :> LifetimeType :> LifetimeType) () +implSubsumeLifetimeM l1 ps_in1 ps_out1 l2 ps_in2 ps_out2 = + implSimplM Proxy (SImpl_SubsumeLifetime l1 ps_in1 ps_out1 l2 ps_in2 ps_out2) >>> + getTopDistPerm l2 >>>= implPopM l2 + + -- | Find all lifetimes that we currently own which could, if ended, help prove -- the specified permissions, and return them with their @lowned@ permissions lifetimesThatCouldProve :: NuMatchingAny1 r => Mb vars (DistPerms ps') -> @@ -4470,13 +4493,19 @@ proveVarLifetimeFunctor' x f args l mb_l psubst = case mbMatch mb_l of | Right l2 <- mbNameBoundP mb_z -> getPerm l2 >>= \case - -- If we have l2:lowned ps, prove l:[l2]lcurrent * l2:lowned ps and then - -- split the lifetime - ValPerm_LOwned ps_in ps_out -> + -- If we have l2:lowned ps, prove l:[l2]lcurrent * l2:lowned ps' for + -- some ps' and then split the lifetime of x. Note that, in proving + -- l:[l2]lcurrent, we can change the lowned permission for l2, + -- specifically if we subsume l1 into l2. + ValPerm_LOwned _ _ -> let (l',l'_p) = lcurrentPerm l l2 in proveVarImplInt l' (fmap (const l'_p) mb_z) >>> - implPushM l2 (ValPerm_LOwned ps_in ps_out) >>> - implSplitLifetimeM x f args l l2 ps_in ps_out + getPerm l2 >>>= \case + l2_p@(ValPerm_LOwned ps_in ps_out) -> + implPushM l2 l2_p >>> + implSplitLifetimeM x f args l l2 ps_in ps_out + _ -> error ("proveVarLifetimeFunctor: unexpected error: " + ++ "l2 lost its lowned perms") -- Otherwise, prove l:[l2]lcurrent and weaken the lifetime _ -> @@ -6058,6 +6087,13 @@ proveVarAtomicImpl x ps mb_p = case mbMatch mb_p of [Perm_LCurrent (PExpr_Var l)] -> proveVarImplInt l (fmap ValPerm_Conj1 mb_p) >>> implSimplM Proxy (SImpl_LCurrentTrans x l l') + [Perm_LOwned ps_in ps_out] + | PExpr_Var l'_var <- l' -> + getSimpleVarPerm l'_var >>= \case + p@(ValPerm_LOwned ps_in' ps_out') -> + implPushM l'_var p >>> + implSubsumeLifetimeM x ps_in ps_out l'_var ps_in' ps_out' + _ -> proveVarAtomicImplUnfoldOrFail x ps mb_p _ -> proveVarAtomicImplUnfoldOrFail x ps mb_p -- If we have a struct permission on the left, eliminate it to a sequence of From fd00a6d0f054cc30809d285bf8fda57be68f0097 Mon Sep 17 00:00:00 2001 From: Eddy Westbrook Date: Fri, 30 Jul 2021 06:32:08 -0700 Subject: [PATCH 04/28] started adding a new version of lowned permissions that include a notion of contained lifetimes, along with an lfinished permission --- .../src/Verifier/SAW/Heapster/Implication.hs | 343 +++++++++--------- .../src/Verifier/SAW/Heapster/Parser.y | 4 +- .../src/Verifier/SAW/Heapster/Permissions.hs | 119 +++--- .../src/Verifier/SAW/Heapster/RustTypes.hs | 2 - .../src/Verifier/SAW/Heapster/TypeChecker.hs | 3 +- .../src/Verifier/SAW/Heapster/UntypedAST.hs | 4 +- 6 files changed, 242 insertions(+), 233 deletions(-) diff --git a/heapster-saw/src/Verifier/SAW/Heapster/Implication.hs b/heapster-saw/src/Verifier/SAW/Heapster/Implication.hs index 60c9fa3d21..3fc8030305 100644 --- a/heapster-saw/src/Verifier/SAW/Heapster/Implication.hs +++ b/heapster-saw/src/Verifier/SAW/Heapster/Implication.hs @@ -66,6 +66,13 @@ import GHC.Stack import Debug.Trace +{- FIXME HERE NOW: +- add contained lifetimes to lowned perms +- remove LOwnedPermLifetime constructor +- change the rules SplitLifetime, SubsumeLifetime, MapLifetime, + EndLifetime, and BeginLifetime +-} + ---------------------------------------------------------------------- -- * Equality Proofs ---------------------------------------------------------------------- @@ -762,27 +769,48 @@ data SimplImpl ps_in ps_out where -- > x:F * l:[l2]lcurrent * l2:lowned (ps_in -o ps_out) -- > -o x:F * l2:lowned (x:F, ps_in -o x:F, ps_out) -- - -- Note that this rule also supports @l=always@, in which case the second - -- permission is just @l2:true@ (as a hack, because it has the same type) + -- Note that this rule also supports @l=always@, in which case the + -- @l:[l2]lcurrent@ permission is replaced by @l2:true@ (as a hack, because it + -- has the same type) SImpl_SplitLifetime :: KnownRepr TypeRepr a => ExprVar a -> LifetimeFunctor args a -> PermExprs args -> PermExpr LifetimeType -> ExprVar LifetimeType -> - LOwnedPerms ps_in -> LOwnedPerms ps_out -> + [PermExpr LifetimeType] -> LOwnedPerms ps_in -> LOwnedPerms ps_out -> SimplImpl (RNil :> a :> LifetimeType :> LifetimeType) (RNil :> a :> LifetimeType) - -- | Subsume a smaller lifetime @l2@ inside a bigger lifetime @l1@, by putting - -- the @lowned@ permission for @l1@ inside that of @l2@: + -- | Subsume a smaller lifetime @l2@ inside a bigger lifetime @l1@, by adding + -- @l2@ to the lifetimes contained in the @lowned@ permission for @l@: -- - -- > l1:lowned (ps_in1 -o ps_out1) * l2:lowned (ps_in2 -o ps_out2) - -- > -o l1:[l2]lcurrent - -- > * l2:lowned (ps_in2 -o l1:lowned (ps_in1 -o ps_out1),ps_out2) - SImpl_SubsumeLifetime :: ExprVar LifetimeType -> - LOwnedPerms ps_in1 -> LOwnedPerms ps_out1 -> - ExprVar LifetimeType -> - LOwnedPerms ps_in2 -> LOwnedPerms ps_out2 -> - SimplImpl (RNil :> LifetimeType :> LifetimeType) - (RNil :> LifetimeType :> LifetimeType) + -- > l1:lowned[ls] (ps_in -o ps_out) -o l1:lowned[l2,ls] (ps_in -o ps_out) + SImpl_SubsumeLifetime :: ExprVar LifetimeType -> [PermExpr LifetimeType] -> + LOwnedPerms ps_in -> LOwnedPerms ps_out -> + PermExpr LifetimeType -> + SimplImpl (RNil :> LifetimeType) + (RNil :> LifetimeType) + + -- | Prove a lifetime @l@ is current during a lifetime @l2@ it contains: + -- + -- > l1:lowned[ls1,l2,ls2] (ps_in -o ps_out) + -- > -o l1:[l2]lcurrent * l1:lowned[ls1,l2,ls2] (ps_in -o ps_out) + SImpl_ContainedLifetimeCurrent :: ExprVar LifetimeType -> + [PermExpr LifetimeType] -> + LOwnedPerms ps_in -> LOwnedPerms ps_out -> + PermExpr LifetimeType -> + SimplImpl (RNil :> LifetimeType) + (RNil :> LifetimeType :> LifetimeType) + + -- | Remove a finshed contained lifetime from an @lowned@ permission: + -- + -- > l1:lowned[ls1,l2,ls2] (ps_in -o ps_out) * l2:lfinished + -- > -o l1:lowned[ls1,ls2] (ps_in -o ps_out) + SImpl_RemoveContainedLifetime :: ExprVar LifetimeType -> + [PermExpr LifetimeType] -> + LOwnedPerms ps_in -> LOwnedPerms ps_out -> + PermExpr LifetimeType -> + SimplImpl + (RNil :> LifetimeType :> LifetimeType) + (RNil :> LifetimeType) -- | Weaken a lifetime in a permission from some @l@ to some @l2@ that is -- contained in @l@, i.e., such that @l@ is current during @l2@, assuming that @@ -799,9 +827,10 @@ data SimplImpl ps_in ps_out where -- -- > Ps1 * Ps_in' -o Ps_in Ps2 * Ps_out -o Ps_out' -- > ---------------------------------------------------------------------- - -- > Ps1 * Ps2 * l:lowned (Ps_in -o Ps_out) -o l:lowned (Ps_in' -o Ps_out') + -- > Ps1 * Ps2 * l:lowned [ls](Ps_in -o Ps_out) -o l:lowned[ls] (Ps_in' -o Ps_out') SImpl_MapLifetime :: - ExprVar LifetimeType -> LOwnedPerms ps_in -> LOwnedPerms ps_out -> + ExprVar LifetimeType -> [PermExpr LifetimeType] -> + LOwnedPerms ps_in -> LOwnedPerms ps_out -> LOwnedPerms ps_in' -> LOwnedPerms ps_out' -> DistPerms ps1 -> DistPerms ps2 -> LocalPermImpl (ps1 :++: ps_in') ps_in -> @@ -810,12 +839,14 @@ data SimplImpl ps_in ps_out where -- | End a lifetime, taking in its @lowned@ permission and all the permissions -- required by the @lowned@ permission to end it, and returning all - -- permissions given back by the @lowned@ lifetime: + -- permissions given back by the @lowned@ lifetime along with an @lfinished@ + -- permission asserting that @l@ has finished: -- - -- > ps_in * l:lowned (ps_in -o ps_out) -o ps_out + -- > ps_in * l:lowned (ps_in -o ps_out) -o ps_out * l:lfinished SImpl_EndLifetime :: ExprVar LifetimeType -> LOwnedPerms ps_in -> LOwnedPerms ps_out -> - SimplImpl (ps_in :> LifetimeType) ps_out + SimplImpl (ps_in :> LifetimeType) + (ps_out :> LifetimeType) -- | Reflexivity for @lcurrent@ proofs: -- @@ -1660,22 +1691,34 @@ simplImplIn (SImpl_LLVMArrayIsPtr x ap) = distPerms1 x (ValPerm_Conj [Perm_LLVMArray ap]) simplImplIn (SImpl_LLVMBlockIsPtr x bp) = distPerms1 x (ValPerm_Conj [Perm_LLVMBlock bp]) -simplImplIn (SImpl_SplitLifetime x f args l l2 ps_in ps_out) = +simplImplIn (SImpl_SplitLifetime x f args l l2 sub_ls ps_in ps_out) = -- If l=always then the second permission is l2:true let (l',l'_p) = lcurrentPerm l l2 in - distPerms3 x (ltFuncApply f args l) l' l'_p l2 (ValPerm_LOwned ps_in ps_out) -simplImplIn (SImpl_SubsumeLifetime l1 ps_in1 ps_out1 l2 ps_in2 ps_out2) = - distPerms2 l1 (ValPerm_LOwned ps_in1 ps_out1) - l2 (ValPerm_LOwned ps_in2 ps_out2) + distPerms3 x (ltFuncApply f args l) l' l'_p + l2 (ValPerm_LOwned sub_ls ps_in ps_out) +simplImplIn (SImpl_SubsumeLifetime l ls ps_in ps_out _) = + distPerms1 l (ValPerm_LOwned ls ps_in ps_out) +simplImplIn (SImpl_ContainedLifetimeCurrent l ls ps_in ps_out l2) = + if elem l2 ls then + distPerms1 l (ValPerm_LOwned ls ps_in ps_out) + else + error ("simplImplIn: SImpl_ContainedLifetimeCurrent: " ++ + "lifetime not in contained lifetimes") +simplImplIn (SImpl_RemoveContainedLifetime l ls ps_in ps_out l2) = + if elem l2 ls then + distPerms2 l (ValPerm_LOwned ls ps_in ps_out) l2 ValPerm_LFinished + else + error ("simplImplIn: SImpl_RemoveContainedLifetime: " ++ + "lifetime not in contained lifetimes") simplImplIn (SImpl_WeakenLifetime x f args l l2) = let (l',l'_p) = lcurrentPerm l l2 in distPerms2 x (ltFuncApply f args l) l' l'_p -simplImplIn (SImpl_MapLifetime l ps_in ps_out _ _ ps1 ps2 _ _) = - RL.append ps1 $ DistPermsCons ps2 l $ ValPerm_LOwned ps_in ps_out +simplImplIn (SImpl_MapLifetime l ls ps_in ps_out _ _ ps1 ps2 _ _) = + RL.append ps1 $ DistPermsCons ps2 l $ ValPerm_LOwned ls ps_in ps_out simplImplIn (SImpl_EndLifetime l ps_in ps_out) = case lownedPermsToDistPerms ps_in of Just perms_in -> - DistPermsCons perms_in l $ ValPerm_LOwned ps_in ps_out + DistPermsCons perms_in l $ ValPerm_LOwned [] ps_in ps_out Nothing -> error "simplImplIn: SImpl_EndLifetime: non-variables in input permissions" simplImplIn (SImpl_LCurrentRefl _) = DistPermsNil @@ -1972,22 +2015,33 @@ simplImplOut (SImpl_LLVMArrayIsPtr x ap) = simplImplOut (SImpl_LLVMBlockIsPtr x bp) = distPerms2 x (ValPerm_Conj1 Perm_IsLLVMPtr) x (ValPerm_Conj [Perm_LLVMBlock bp]) -simplImplOut (SImpl_SplitLifetime x f args l l2 ps_in ps_out) = +simplImplOut (SImpl_SplitLifetime x f args l l2 sub_ls ps_in ps_out) = distPerms2 x (ltFuncApply f args $ PExpr_Var l2) - l2 (ValPerm_LOwned + l2 (ValPerm_LOwned sub_ls (ps_in :>: ltFuncMinApplyLOP x f (PExpr_Var l2)) (ps_out :>: ltFuncApplyLOP x f args l)) -simplImplOut (SImpl_SubsumeLifetime l1 ps_in1 _ps_out1 l2 ps_in2 ps_out2) = - distPerms2 l1 (ValPerm_LCurrent $ PExpr_Var l2) - l2 (ValPerm_LOwned ps_in2 - (ps_out2 :>: LOwnedPermLifetime (PExpr_Var l1) ps_in1 ps_out2)) +simplImplOut (SImpl_SubsumeLifetime l ls ps_in ps_out l2) = + distPerms1 l (ValPerm_LOwned (l2:ls) ps_in ps_out) +simplImplOut (SImpl_ContainedLifetimeCurrent l ls ps_in ps_out l2) = + if elem l2 ls then + distPerms2 l (ValPerm_LCurrent l2) l (ValPerm_LOwned ls ps_in ps_out) + else + error ("simplImplOut: SImpl_ContainedLifetimeCurrent: " ++ + "lifetime not in contained lifetimes") +simplImplOut (SImpl_RemoveContainedLifetime l ls ps_in ps_out l2) = + if elem l2 ls then + distPerms1 l (ValPerm_LOwned (delete l2 ls) ps_in ps_out) + else + error ("simplImplOut: SImpl_RemoveContainedLifetime: " ++ + "lifetime not in contained lifetimes") simplImplOut (SImpl_WeakenLifetime x f args _ l2) = distPerms1 x (ltFuncApply f args $ PExpr_Var l2) -simplImplOut (SImpl_MapLifetime l _ _ ps_in' ps_out' _ _ _ _) = - distPerms1 l $ ValPerm_LOwned ps_in' ps_out' -simplImplOut (SImpl_EndLifetime _ _ ps_out) = +simplImplOut (SImpl_MapLifetime l ls _ _ ps_in' ps_out' _ _ _ _) = + distPerms1 l $ ValPerm_LOwned ls ps_in' ps_out' +simplImplOut (SImpl_EndLifetime l _ ps_out) = case lownedPermsToDistPerms ps_out of - Just perms_out -> perms_out + Just perms_out -> + DistPermsCons perms_out l ValPerm_LFinished _ -> error "simplImplOut: SImpl_EndLifetime: non-variable in output permissions" simplImplOut (SImpl_LCurrentRefl l) = distPerms1 l (ValPerm_LCurrent $ PExpr_Var l) @@ -2221,7 +2275,7 @@ applyImpl1 _ (Impl1_ElimLLVMBlockToEq x bp) ps = else error "applyImpl1: SImpl_ElimLLVMBlockToEq: unexpected permission" applyImpl1 _ Impl1_BeginLifetime ps = - mbPermSets1 $ nu $ \l -> pushPerm l (ValPerm_LOwned MNil MNil) ps + mbPermSets1 $ nu $ \l -> pushPerm l (ValPerm_LOwned [] MNil MNil) ps applyImpl1 _ (Impl1_TryProveBVProp x prop _) ps = mbPermSets1 $ emptyMb $ pushPerm x (ValPerm_Conj [Perm_BVProp prop]) ps @@ -2366,20 +2420,29 @@ instance SubstVar PermVarSubst m => SImpl_LLVMArrayIsPtr <$> genSubst s x <*> genSubst s ap [nuMP| SImpl_LLVMBlockIsPtr x bp |] -> SImpl_LLVMBlockIsPtr <$> genSubst s x <*> genSubst s bp - [nuMP| SImpl_SplitLifetime x f args l l2 ps_in ps_out |] -> + [nuMP| SImpl_SplitLifetime x f args l l2 sub_ls ps_in ps_out |] -> SImpl_SplitLifetime <$> genSubst s x <*> genSubst s f <*> genSubst s args <*> genSubst s l <*> genSubst s l2 + <*> genSubst s sub_ls <*> genSubst s ps_in <*> genSubst s ps_out - [nuMP| SImpl_SubsumeLifetime l1 ps_in1 ps_out1 l2 ps_in2 ps_out2 |] -> - SImpl_SubsumeLifetime <$> genSubst s l1 <*> genSubst s ps_in1 - <*> genSubst s ps_out1 <*> genSubst s l2 - <*> genSubst s ps_in2 <*> genSubst s ps_out2 + [nuMP| SImpl_SubsumeLifetime l ls ps_in ps_out l2 |] -> + SImpl_SubsumeLifetime <$> genSubst s l <*> genSubst s ls + <*> genSubst s ps_in <*> genSubst s ps_out + <*> genSubst s l2 + [nuMP| SImpl_ContainedLifetimeCurrent l ls ps_in ps_out l2 |] -> + SImpl_ContainedLifetimeCurrent <$> genSubst s l <*> genSubst s ls + <*> genSubst s ps_in <*> genSubst s ps_out + <*> genSubst s l2 + [nuMP| SImpl_RemoveContainedLifetime l ls ps_in ps_out l2 |] -> + SImpl_RemoveContainedLifetime <$> genSubst s l <*> genSubst s ls + <*> genSubst s ps_in <*> genSubst s ps_out + <*> genSubst s l2 [nuMP| SImpl_WeakenLifetime x f args l l2 |] -> SImpl_WeakenLifetime <$> genSubst s x <*> genSubst s f <*> genSubst s args <*> genSubst s l <*> genSubst s l2 - [nuMP| SImpl_MapLifetime l ps_in ps_out ps_in' ps_out' + [nuMP| SImpl_MapLifetime l ls ps_in ps_out ps_in' ps_out' ps1 ps2 impl1 impl2 |] -> - SImpl_MapLifetime <$> genSubst s l <*> genSubst s ps_in + SImpl_MapLifetime <$> genSubst s l <*> genSubst s ls <*> genSubst s ps_in <*> genSubst s ps_out <*> genSubst s ps_in' <*> genSubst s ps_out' <*> genSubst s ps1 <*> genSubst s ps2 <*> genSubst s impl1 @@ -2551,12 +2614,6 @@ data ImplState vars ps = _implStateVars :: CruCtx vars, _implStatePSubst :: PartialSubst vars, _implStatePVarSubst :: RAssign (Compose Maybe ExprVar) vars, - -- FIXME HERE: remove implStateLifetimes - _implStateLifetimes :: [ExprVar LifetimeType], - -- ^ Stack of active lifetimes, where the first element is the - -- current lifetime (we should have an @lowned@ permission for it) - -- and each lifetime contains (i.e., has an @lcurrent@ permission - -- for) the next lifetime in the stack _implStateRecRecurseFlag :: RecurseFlag, -- ^ Whether we are recursing under a recursive permission, either -- on the left hand or the right hand side @@ -2582,7 +2639,6 @@ mkImplState vars perms env info fail_prefix do_trace nameTypes = _implStatePerms = perms, _implStatePSubst = emptyPSubst vars, _implStatePVarSubst = RL.map (const $ Compose Nothing) (cruCtxProxies vars), - _implStateLifetimes = [], _implStateRecRecurseFlag = RecNone, _implStatePermEnv = env, _implStatePPInfo = info, @@ -2834,59 +2890,6 @@ setPerms perms = implStatePerms .= perms setPerm :: ExprVar a -> ValuePerm a -> ImplM vars s r ps ps () setPerm x p = implStatePerms . varPerm x .= p --- | Get the current lifetime -getCurLifetime :: ImplM vars s r ps ps (ExprVar LifetimeType) -getCurLifetime = - do ls <- use implStateLifetimes - case ls of - l:_ -> pure l - [] -> error "getCurLifetime: no current lifetime!" - --- | Push a lifetime onto the lifetimes stack -pushLifetime :: ExprVar LifetimeType -> ImplM vars s r ps ps () -pushLifetime l = implStateLifetimes %= (l:) - --- | Pop a lifetime off of the lifetimes stack -popLifetime :: ImplM vars s r ps ps (ExprVar LifetimeType) -popLifetime = - do l <- getCurLifetime - implStateLifetimes %= tail - pure l - --- | Push (as in 'implPushM') the permission for the current lifetime -implPushCurLifetimePermM :: NuMatchingAny1 r => ExprVar LifetimeType -> - ImplM vars s r (ps :> LifetimeType) ps () -implPushCurLifetimePermM l = - getCurLifetime >>>= \l' -> - (if l == l' then pure () else - error "implPushLifetimePermM: wrong value for the current lifetime!") >>> - getPerm l >>>= \p -> - case p of - ValPerm_Conj [Perm_LOwned _ _] -> implPushM l p - _ -> error "implPushLifetimePermM: no LOwned permission for the current lifetime!" - --- | Pop (as in 'implPopM') the permission for the current lifetime -implPopCurLifetimePermM :: NuMatchingAny1 r => ExprVar LifetimeType -> - ImplM vars s r ps (ps :> LifetimeType) () -implPopCurLifetimePermM l = - getCurLifetime >>>= \l' -> - (if l == l' then pure () else - error "implPopLifetimePermM: wrong value for the current lifetime!") >>> - getTopDistPerm l >>>= \p -> - case p of - ValPerm_Conj [Perm_LOwned _ _] -> implPopM l p - _ -> error "implPopLifetimePermM: no LOwned permission for the current lifetime!" - -{- FIXME: this should no longer be needed! --- | Map the final return value and the current permissions -gmapRetAndPerms :: (PermSet ps2 -> PermSet ps1) -> - (PermImpl r ps1 -> PermImpl r ps2) -> - ImplM vars s r ps1 ps2 () -gmapRetAndPerms f_perms f_impl = - gmapRetAndState (over implStatePerms f_perms) f_impl --} - - -- | Look up the type of a free variable implGetVarType :: Name a -> ImplM vars s r ps ps (TypeRepr a) implGetVarType n = @@ -3685,7 +3688,7 @@ implBeginLifetimeM :: NuMatchingAny1 r => implBeginLifetimeM = implApplyImpl1 Impl1_BeginLifetime (MNil :>: Impl1Cont (\(_ :>: n) -> pure n)) >>>= \l -> - implPopM l (ValPerm_LOwned MNil MNil) >>> + implPopM l (ValPerm_LOwned [] MNil MNil) >>> pure l -- | End a lifetime, assuming the top of the stack is of the form @@ -3698,7 +3701,7 @@ implEndLifetimeM :: NuMatchingAny1 r => Proxy ps -> ExprVar LifetimeType -> ImplM vars s r ps (ps :++: ps_in :> LifetimeType) () implEndLifetimeM ps l ps_in ps_out@(lownedPermsToDistPerms -> Just dps_out) = implSimplM ps (SImpl_EndLifetime l ps_in ps_out) >>> - recombinePermsPartial ps dps_out + recombinePermsPartial ps (DistPermsCons dps_out l ValPerm_LFinished) implEndLifetimeM _ _ _ _ = implFailM "implEndLifetimeM: lownedPermsToDistPerms" @@ -3713,37 +3716,65 @@ implEndLifetimeM _ _ _ _ = implFailM "implEndLifetimeM: lownedPermsToDistPerms" implSplitLifetimeM :: (KnownRepr TypeRepr a, NuMatchingAny1 r) => ExprVar a -> LifetimeFunctor args a -> PermExprs args -> PermExpr LifetimeType -> - ExprVar LifetimeType -> + ExprVar LifetimeType -> [PermExpr LifetimeType] -> LOwnedPerms ps_in -> LOwnedPerms ps_out -> ImplM vars s r (ps :> a) (ps :> a :> LifetimeType :> LifetimeType) () -implSplitLifetimeM x f args l l2 ps_in ps_out = +implSplitLifetimeM x f args l l2 sub_ls ps_in ps_out = implTraceM (\i -> sep [pretty "Splitting lifetime to" <+> permPretty i l2 <> colon, permPretty i (ltFuncMinApply f l)]) >>> - implSimplM Proxy (SImpl_SplitLifetime x f args l l2 ps_in ps_out) >>> + implSimplM Proxy (SImpl_SplitLifetime x f args l l2 sub_ls ps_in ps_out) >>> getTopDistPerm l2 >>>= implPopM l2 --- | Subsume a smaller lifetime @l2@ inside a bigger lifetime @l1@, by putting --- the @lowned@ permission for @l1@ inside that of @l2@. Assume permissions +-- | Subsume a smaller lifetime @l2@ inside a bigger lifetime @l1@, by adding +-- @l2@ to the lifetimes contained in the @lowned@ permission for @l@. Assume +-- the top of the stack is @l1:lowned[ls] (ps_in1 -o ps_out1)@, and replace that +-- permission with @l1:lowned[l2,ls] (ps_in1 -o ps_out1)@. +implSubsumeLifetimeM :: NuMatchingAny1 r => ExprVar LifetimeType -> + [PermExpr LifetimeType] -> + LOwnedPerms ps_in -> LOwnedPerms ps_out -> + PermExpr LifetimeType -> + ImplM vars s r (ps :> LifetimeType) + (ps :> LifetimeType) () +implSubsumeLifetimeM l ls ps_in ps_out l2 = + implSimplM Proxy (SImpl_SubsumeLifetime l ls ps_in ps_out l2) + + +-- | Prove a lifetime @l@ is current during a lifetime @l2@ it contains, +-- assuming the permission -- --- > l1:lowned (ps_in1 -o ps_out1) * l2:lowned (ps_in2 -o ps_out2) +-- > l1:lowned[ls1,l2,ls2] (ps_in -o ps_out) -- --- are on top of the stack, and change the permissions on @l2@ to +-- is on top of the stack, and replacing it with @l1:[l2]lcurrent@. +implContainedLifetimeCurrentM :: NuMatchingAny1 r => ExprVar LifetimeType -> + [PermExpr LifetimeType] -> + LOwnedPerms ps_in -> LOwnedPerms ps_out -> + PermExpr LifetimeType -> + ImplM vars s r (ps :> LifetimeType) + (ps :> LifetimeType) () +implContainedLifetimeCurrentM l ls ps_in ps_out l2 = + implSimplM Proxy (SImpl_ContainedLifetimeCurrent l ls ps_in ps_out l2) >>> + implPopM l (ValPerm_LOwned ls ps_in ps_out) + + +-- | Remove a finshed contained lifetime from an @lowned@ permission, assuming +-- the permissions -- --- > l2:lowned (ps_in2 -o l1:lowned (ps_in1 -o ps_out1),ps_out2) +-- > l1:lowned[ls1,l2,ls2] (ps_in -o ps_out) * l2:lfinished -- --- which is popped off the stack, leaving @l1:[l2]lcurrent@ on the stack. -implSubsumeLifetimeM :: NuMatchingAny1 r => ExprVar LifetimeType -> - LOwnedPerms ps_in1 -> LOwnedPerms ps_out1 -> - ExprVar LifetimeType -> - LOwnedPerms ps_in2 -> LOwnedPerms ps_out2 -> - ImplM vars s r (ps :> LifetimeType) - (ps :> LifetimeType :> LifetimeType) () -implSubsumeLifetimeM l1 ps_in1 ps_out1 l2 ps_in2 ps_out2 = - implSimplM Proxy (SImpl_SubsumeLifetime l1 ps_in1 ps_out1 l2 ps_in2 ps_out2) >>> - getTopDistPerm l2 >>>= implPopM l2 +-- are on top of the stack and replacing them with +-- +-- > l1:lowned[ls1,ls2] (ps_in -o ps_out) +implRemoveContainedLifetimeM :: NuMatchingAny1 r => ExprVar LifetimeType -> + [PermExpr LifetimeType] -> + LOwnedPerms ps_in -> LOwnedPerms ps_out -> + PermExpr LifetimeType -> + ImplM vars s r (ps :> LifetimeType) + (ps :> LifetimeType :> LifetimeType) () +implRemoveContainedLifetimeM l ls ps_in ps_out l2 = + implSimplM Proxy (SImpl_RemoveContainedLifetime l ls ps_in ps_out l2) -- | Find all lifetimes that we currently own which could, if ended, help prove @@ -3755,9 +3786,9 @@ lifetimesThatCouldProve mb_ps = do Some all_perms <- uses implStatePerms permSetAllVarPerms pure (RL.foldr (\case - VarAndPerm l (ValPerm_LOwned ps_in ps_out) + VarAndPerm l (ValPerm_LOwned ls ps_in ps_out) | mbLift $ fmap (lownedPermsCouldProve ps_out) mb_ps -> - ((l, Perm_LOwned ps_in ps_out) :) + ((l, Perm_LOwned ls ps_in ps_out) :) _ -> id) [] all_perms) @@ -4048,8 +4079,8 @@ getLifetimeCurrentPerms :: NuMatchingAny1 r => PermExpr LifetimeType -> getLifetimeCurrentPerms PExpr_Always = pure $ Some AlwaysCurrentPerms getLifetimeCurrentPerms (PExpr_Var l) = getPerm l >>= \case - ValPerm_LOwned ps_in ps_out -> - pure $ Some $ LOwnedCurrentPerms l ps_in ps_out + ValPerm_LOwned ls ps_in ps_out -> + pure $ Some $ LOwnedCurrentPerms l ls ps_in ps_out ValPerm_LCurrent l' -> getLifetimeCurrentPerms l' >>= \some_cur_perms -> case some_cur_perms of @@ -4063,8 +4094,8 @@ getLifetimeCurrentPerms (PExpr_Var l) = proveLifetimeCurrent :: NuMatchingAny1 r => LifetimeCurrentPerms ps_l -> ImplM vars s r (ps :++: ps_l) ps () proveLifetimeCurrent AlwaysCurrentPerms = pure () -proveLifetimeCurrent (LOwnedCurrentPerms l ps_in ps_out) = - implPushM l (ValPerm_LOwned ps_in ps_out) +proveLifetimeCurrent (LOwnedCurrentPerms l ls ps_in ps_out) = + implPushM l (ValPerm_LOwned ls ps_in ps_out) proveLifetimeCurrent (CurrentTransPerms cur_perms l) = proveLifetimeCurrent cur_perms >>> let l' = lifetimeCurrentPermsLifetime cur_perms @@ -4256,8 +4287,8 @@ recombineLifetimeCurrentPerms :: NuMatchingAny1 r => LifetimeCurrentPerms ps_l -> ImplM vars s r ps (ps :++: ps_l) () recombineLifetimeCurrentPerms AlwaysCurrentPerms = pure () -recombineLifetimeCurrentPerms (LOwnedCurrentPerms l ps_in ps_out) = - recombinePermExpl l ValPerm_True (ValPerm_LOwned ps_in ps_out) +recombineLifetimeCurrentPerms (LOwnedCurrentPerms l ls ps_in ps_out) = + recombinePermExpl l ValPerm_True (ValPerm_LOwned ls ps_in ps_out) recombineLifetimeCurrentPerms (CurrentTransPerms cur_perms l) = implDropM l (ValPerm_LCurrent $ lifetimeCurrentPermsLifetime cur_perms) >>> recombineLifetimeCurrentPerms cur_perms @@ -4497,13 +4528,13 @@ proveVarLifetimeFunctor' x f args l mb_l psubst = case mbMatch mb_l of -- some ps' and then split the lifetime of x. Note that, in proving -- l:[l2]lcurrent, we can change the lowned permission for l2, -- specifically if we subsume l1 into l2. - ValPerm_LOwned _ _ -> + ValPerm_LOwned _ _ _ -> let (l',l'_p) = lcurrentPerm l l2 in proveVarImplInt l' (fmap (const l'_p) mb_z) >>> getPerm l2 >>>= \case - l2_p@(ValPerm_LOwned ps_in ps_out) -> + l2_p@(ValPerm_LOwned sub_ls ps_in ps_out) -> implPushM l2 l2_p >>> - implSplitLifetimeM x f args l l2 ps_in ps_out + implSplitLifetimeM x f args l l2 sub_ls ps_in ps_out _ -> error ("proveVarLifetimeFunctor: unexpected error: " ++ "l2 lost its lowned perms") @@ -4613,24 +4644,6 @@ solveForPermListImpl ps_l mb_ps = case mbMatch mb_ps of needed2 <- solveForPermListImpl ps_l mb_ps_r pure (apSomeRAssign needed1 needed2) - -- If the RHS is an lowned perm that is in the LHS, return nothing - -- - -- FIXME HERE: recursively call solveForPermListImpl on the the lists of - -- permissions in the lifetimes - [nuMP| mb_ps_r :>: LOwnedPermLifetime (PExpr_Var mb_l) _ _ |] - | Right l <- mbNameBoundP mb_l - , RL.foldr (\lop rest -> - case lop of - LOwnedPermLifetime (PExpr_Var l') _ _ - | l == l' -> True - _ -> rest) False ps_l -> - solveForPermListImpl ps_l mb_ps_r - - -- If the RHS is an lowned perm not in the LHS, return the RHS - [nuMP| mb_ps_r :>: LOwnedPermLifetime (PExpr_Var mb_l) mb_ps_in mb_ps_out |] -> - apSomeRAssign (neededPerms1 mb_l (mbMap2 ValPerm_LOwned mb_ps_in mb_ps_out)) <$> - solveForPermListImpl ps_l mb_ps_r - -- Otherwise, we don't know what to do, so do nothing and return _ -> pure (Some MNil) @@ -6009,8 +6022,8 @@ proveVarAtomicImpl x ps mb_p = case mbMatch mb_p of proveEq fperms mb_fperms >>>= \eqp -> implCastPermM x (fmap (ValPerm_Conj1 . Perm_LLVMFrame) eqp) - [nuMP| Perm_LOwned mb_ps_inR mb_ps_outR |] - | [Perm_LOwned ps_inL ps_outL] <- ps -> + [nuMP| Perm_LOwned mb_ls mb_ps_inR mb_ps_outR |] + | [Perm_LOwned ls ps_inL ps_outL] <- ps -> -- First, simplify both sides using any current equality permissions. This -- just builds the equality proofs and computes the new LHS and RHS, but @@ -6053,7 +6066,7 @@ proveVarAtomicImpl x ps mb_p = case mbMatch mb_p of getPSubst >>>= \psubst -> let eqp_R = fmap (\(mb_ps_in,mb_ps_out) -> - ValPerm_LOwned + ValPerm_LOwned ls (partialSubstForce psubst mb_ps_in "proveVarAtomicImpl") (partialSubstForce psubst mb_ps_out "proveVarAtomicImpl")) eqp_mb_psR in @@ -6072,8 +6085,8 @@ proveVarAtomicImpl x ps mb_p = case mbMatch mb_p of -- lowned permissions and casting it, and then cast the result implPushM x (ValPerm_Conj ps) >>> implCastPermM x (fmap (\(ps_in,ps_out) -> - ValPerm_LOwned ps_in ps_out) eqp_psL) >>> - implSimplM Proxy (SImpl_MapLifetime x ps_inL' ps_outL' ps_inR' ps_outR' + ValPerm_LOwned ls ps_in ps_out) eqp_psL) >>> + implSimplM Proxy (SImpl_MapLifetime x ls ps_inL' ps_outL' ps_inR' ps_outR' ps1 ps2 impl_in impl_out) >>> implCastPermM x (someEqProofSym eqp_R) @@ -6087,13 +6100,11 @@ proveVarAtomicImpl x ps mb_p = case mbMatch mb_p of [Perm_LCurrent (PExpr_Var l)] -> proveVarImplInt l (fmap ValPerm_Conj1 mb_p) >>> implSimplM Proxy (SImpl_LCurrentTrans x l l') - [Perm_LOwned ps_in ps_out] - | PExpr_Var l'_var <- l' -> - getSimpleVarPerm l'_var >>= \case - p@(ValPerm_LOwned ps_in' ps_out') -> - implPushM l'_var p >>> - implSubsumeLifetimeM x ps_in ps_out l'_var ps_in' ps_out' - _ -> proveVarAtomicImplUnfoldOrFail x ps mb_p + [Perm_LOwned ls ps_in ps_out] + | elem l' ls -> implContainedLifetimeCurrentM x ls ps_in ps_out l' + [Perm_LOwned sub_ls ps_in ps_out] -> + implSubsumeLifetimeM x ls ps_in ps_out l' >>> + implContainedLifetimeCurrentM x (l':ls) ps_in ps_out l' _ -> proveVarAtomicImplUnfoldOrFail x ps mb_p -- If we have a struct permission on the left, eliminate it to a sequence of diff --git a/heapster-saw/src/Verifier/SAW/Heapster/Parser.y b/heapster-saw/src/Verifier/SAW/Heapster/Parser.y index 6d2bcd39ce..3035d01175 100644 --- a/heapster-saw/src/Verifier/SAW/Heapster/Parser.y +++ b/heapster-saw/src/Verifier/SAW/Heapster/Parser.y @@ -180,7 +180,9 @@ expr :: { AstExpr } | 'shape' '(' expr ')' { ExShape (pos $1) $3} | 'lowned' '(' list(varExpr) '-o' list1(varExpr) ')' - { ExLOwned (pos $1) $3 $5} + { ExLOwned (pos $1) [] $3 $5} + | 'lowned' '[' list(expr) ']' '(' list(varExpr) '-o' list1(varExpr) ')' + { ExLOwned (pos $1) $3 $6 $8} | lifetime 'lcurrent' { ExLCurrent (pos $2) $1 } -- BV Props (Value Permissions) diff --git a/heapster-saw/src/Verifier/SAW/Heapster/Permissions.hs b/heapster-saw/src/Verifier/SAW/Heapster/Permissions.hs index b33ce4e0ff..ff4f0c4522 100644 --- a/heapster-saw/src/Verifier/SAW/Heapster/Permissions.hs +++ b/heapster-saw/src/Verifier/SAW/Heapster/Permissions.hs @@ -1407,12 +1407,18 @@ data AtomicPerm (a :: CrucibleType) where -- these are a form of permission implication, so we write lifetime ownership -- permissions as @lowned(Pin -o Pout)@. Intuitively, @Pin@ must be given back -- before the lifetime is ended, and @Pout@ is returned afterwards. - Perm_LOwned :: LOwnedPerms ps_in -> LOwnedPerms ps_out -> + -- Additionally, a lifetime may contain some other lifetimes, meaning the all + -- must end before the current one can be ended. + Perm_LOwned :: [PermExpr LifetimeType] -> + LOwnedPerms ps_in -> LOwnedPerms ps_out -> AtomicPerm LifetimeType -- | Assertion that a lifetime is current during another lifetime Perm_LCurrent :: PermExpr LifetimeType -> AtomicPerm LifetimeType + -- | Assertion that a lifetime has finished + Perm_LFinished :: AtomicPerm LifetimeType + -- | A struct permission = a sequence of permissions for each field Perm_Struct :: RAssign ValuePerm (CtxToRList ctx) -> AtomicPerm (StructType ctx) @@ -1496,11 +1502,12 @@ pattern ValPerm_LLVMBlockShape sh <- ValPerm_Conj [Perm_LLVMBlockShape sh] ValPerm_LLVMBlockShape sh = ValPerm_Conj [Perm_LLVMBlockShape sh] -- | A single @lowned@ permission -pattern ValPerm_LOwned :: () => (a ~ LifetimeType) => +pattern ValPerm_LOwned :: () => (a ~ LifetimeType) => [PermExpr LifetimeType] -> LOwnedPerms ps_in -> LOwnedPerms ps_out -> ValuePerm a -pattern ValPerm_LOwned ps_in ps_out <- ValPerm_Conj [Perm_LOwned ps_in ps_out] +pattern ValPerm_LOwned ls ps_in ps_out <- ValPerm_Conj [Perm_LOwned + ls ps_in ps_out] where - ValPerm_LOwned ps_in ps_out = ValPerm_Conj [Perm_LOwned ps_in ps_out] + ValPerm_LOwned ls ps_in ps_out = ValPerm_Conj [Perm_LOwned ls ps_in ps_out] -- | A single @lcurrent@ permission pattern ValPerm_LCurrent :: () => (a ~ LifetimeType) => @@ -1509,6 +1516,12 @@ pattern ValPerm_LCurrent l <- ValPerm_Conj [Perm_LCurrent l] where ValPerm_LCurrent l = ValPerm_Conj [Perm_LCurrent l] +-- | A single @lfinished@ permission +pattern ValPerm_LFinished :: () => (a ~ LifetimeType) => ValuePerm a +pattern ValPerm_LFinished <- ValPerm_Conj [Perm_LFinished] + where + ValPerm_LFinished = ValPerm_Conj [Perm_LFinished] + -- | A sequence of value permissions {- data ValuePerms as where @@ -1694,9 +1707,6 @@ data LOwnedPerm a where LOwnedPerm (LLVMPointerType w) LOwnedPermBlock :: (1 <= w, KnownNat w) => PermExpr (LLVMPointerType w) -> LLVMBlockPerm w -> LOwnedPerm (LLVMPointerType w) - LOwnedPermLifetime :: PermExpr LifetimeType -> - LOwnedPerms ps_in -> LOwnedPerms ps_out -> - LOwnedPerm LifetimeType -- | A sequence of 'LOwnedPerm's type LOwnedPerms = RAssign LOwnedPerm @@ -1713,13 +1723,6 @@ instance TestEquality LOwnedPerm where , e1 == e2 && bp1 == bp2 = Just Refl testEquality (LOwnedPermBlock _ _) _ = Nothing - testEquality (LOwnedPermLifetime e1 ps_in1 ps_out1) - (LOwnedPermLifetime e2 ps_in2 ps_out2) - | Just Refl <- testEquality ps_in1 ps_in2 - , Just Refl <- testEquality ps_out1 ps_out2 - , e1 == e2 - = Just Refl - testEquality (LOwnedPermLifetime _ _ _) _ = Nothing instance Eq (LOwnedPerm a) where lop1 == lop2 | Just Refl <- testEquality lop1 lop2 = True @@ -1734,8 +1737,6 @@ lownedPermExprAndPerm (LOwnedPermField e fp) = ExprAndPerm e $ ValPerm_LLVMField fp lownedPermExprAndPerm (LOwnedPermBlock e bp) = ExprAndPerm e $ ValPerm_LLVMBlock bp -lownedPermExprAndPerm (LOwnedPermLifetime e ps_in ps_out) = - ExprAndPerm e $ ValPerm_LOwned ps_in ps_out -- | Convert an 'LOwnedPerm' to a variable plus permission, if possible lownedPermVarAndPerm :: LOwnedPerm a -> Maybe (VarAndPerm a) @@ -1750,8 +1751,6 @@ varAndPermLOwnedPerm (VarAndPerm x (ValPerm_LLVMField fp)) = Just $ LOwnedPermField (PExpr_Var x) fp varAndPermLOwnedPerm (VarAndPerm x (ValPerm_LLVMBlock bp)) = Just $ LOwnedPermBlock (PExpr_Var x) bp -varAndPermLOwnedPerm (VarAndPerm x (ValPerm_LOwned ps_in ps_out)) = - Just $ LOwnedPermLifetime (PExpr_Var x) ps_in ps_out varAndPermLOwnedPerm _ = Nothing -- | Get the expression part of an 'LOwnedPerm' @@ -2341,8 +2340,8 @@ data LifetimeCurrentPerms ps_l where AlwaysCurrentPerms :: LifetimeCurrentPerms RNil -- | A variable @l@ that is @lowned@ is current, requiring perms -- - -- > l:lowned(ps_in -o ps_out) - LOwnedCurrentPerms :: ExprVar LifetimeType -> + -- > l:lowned[ls](ps_in -o ps_out) + LOwnedCurrentPerms :: ExprVar LifetimeType -> [PermExpr LifetimeType] -> LOwnedPerms ps_in -> LOwnedPerms ps_out -> LifetimeCurrentPerms (RNil :> LifetimeType) @@ -2357,14 +2356,14 @@ data LifetimeCurrentPerms ps_l where lifetimeCurrentPermsLifetime :: LifetimeCurrentPerms ps_l -> PermExpr LifetimeType lifetimeCurrentPermsLifetime AlwaysCurrentPerms = PExpr_Always -lifetimeCurrentPermsLifetime (LOwnedCurrentPerms l _ _) = PExpr_Var l +lifetimeCurrentPermsLifetime (LOwnedCurrentPerms l _ _ _) = PExpr_Var l lifetimeCurrentPermsLifetime (CurrentTransPerms _ l) = PExpr_Var l -- | Convert a 'LifetimeCurrentPerms' to the 'DistPerms' it represent lifetimeCurrentPermsPerms :: LifetimeCurrentPerms ps_l -> DistPerms ps_l lifetimeCurrentPermsPerms AlwaysCurrentPerms = DistPermsNil -lifetimeCurrentPermsPerms (LOwnedCurrentPerms l ps_in ps_out) = - DistPermsCons DistPermsNil l $ ValPerm_LOwned ps_in ps_out +lifetimeCurrentPermsPerms (LOwnedCurrentPerms l ls ps_in ps_out) = + DistPermsCons DistPermsNil l $ ValPerm_LOwned ls ps_in ps_out lifetimeCurrentPermsPerms (CurrentTransPerms cur_ps l) = DistPermsCons (lifetimeCurrentPermsPerms cur_ps) l $ ValPerm_Conj1 $ Perm_LCurrent $ lifetimeCurrentPermsLifetime cur_ps @@ -2374,7 +2373,7 @@ mbLifetimeCurrentPermsProxies :: Mb ctx (LifetimeCurrentPerms ps_l) -> RAssign Proxy ps_l mbLifetimeCurrentPermsProxies mb_l = case mbMatch mb_l of [nuMP| AlwaysCurrentPerms |] -> MNil - [nuMP| LOwnedCurrentPerms _ _ _ |] -> MNil :>: Proxy + [nuMP| LOwnedCurrentPerms _ _ _ _ |] -> MNil :>: Proxy [nuMP| CurrentTransPerms cur_ps _ |] -> mbLifetimeCurrentPermsProxies cur_ps :>: Proxy @@ -2488,13 +2487,15 @@ instance Eq (AtomicPerm a) where (Perm_LLVMBlockShape _) == _ = False (Perm_LLVMFrame frame1) == (Perm_LLVMFrame frame2) = frame1 == frame2 (Perm_LLVMFrame _) == _ = False - (Perm_LOwned ps_in1 ps_out1) == (Perm_LOwned ps_in2 ps_out2) + (Perm_LOwned ls1 ps_in1 ps_out1) == (Perm_LOwned ls2 ps_in2 ps_out2) | Just Refl <- testEquality ps_in1 ps_in2 , Just Refl <- testEquality ps_out1 ps_out2 - = True - (Perm_LOwned _ _) == _ = False + = ls1 == ls2 + (Perm_LOwned _ _ _) == _ = False (Perm_LCurrent e1) == (Perm_LCurrent e2) = e1 == e2 (Perm_LCurrent _) == _ = False + Perm_LFinished == Perm_LFinished = True + Perm_LFinished == _ = False (Perm_Struct ps1) == (Perm_Struct ps2) = ps1 == ps2 (Perm_Struct _) == _ = False (Perm_Fun fperm1) == (Perm_Fun fperm2) @@ -2644,12 +2645,16 @@ instance PermPretty (AtomicPerm a) where permPrettyM (Perm_LLVMFrame fperm) = do pps <- mapM (\(e,i) -> (<> (colon <> pretty i)) <$> permPrettyM e) fperm return (pretty "llvmframe" <+> ppEncList False pps) - permPrettyM (Perm_LOwned ps_in ps_out) = + permPrettyM (Perm_LOwned ls ps_in ps_out) = do pp_in <- permPrettyM ps_in pp_out <- permPrettyM ps_out - return (pretty "lowned" <+> parens (align $ - sep [pp_in, pretty "-o", pp_out])) + ls_pp <- case ls of + [] -> return emptyDoc + _ -> ppEncList False <$> mapM permPrettyM ls + return (pretty "lowned" <> ls_pp <+> + parens (align $ sep [pp_in, pretty "-o", pp_out])) permPrettyM (Perm_LCurrent l) = (pretty "lcurrent" <+>) <$> permPrettyM l + permPrettyM Perm_LFinished = return (pretty "lfinished") permPrettyM (Perm_Struct ps) = ((pretty "struct" <+>) . parens) <$> permPrettyM ps permPrettyM (Perm_Fun fun_perm) = permPrettyM fun_perm @@ -2913,8 +2918,9 @@ isLLVMBlockPerm _ = False -- | Test if an 'AtomicPerm' is a lifetime permission isLifetimePerm :: AtomicPerm a -> Maybe (a :~: LifetimeType) -isLifetimePerm (Perm_LOwned _ _) = Just Refl +isLifetimePerm (Perm_LOwned _ _ _) = Just Refl isLifetimePerm (Perm_LCurrent _) = Just Refl +isLifetimePerm Perm_LFinished = Just Refl isLifetimePerm _ = Nothing -- | Test if an 'AtomicPerm' is a struct permission @@ -4319,8 +4325,9 @@ atomicPermIsCopyable (Perm_LLVMFunPtr _ _) = True atomicPermIsCopyable Perm_IsLLVMPtr = True atomicPermIsCopyable (Perm_LLVMBlockShape sh) = shapeIsCopyable PExpr_Write sh atomicPermIsCopyable (Perm_LLVMFrame _) = False -atomicPermIsCopyable (Perm_LOwned _ _) = False +atomicPermIsCopyable (Perm_LOwned _ _ _) = False atomicPermIsCopyable (Perm_LCurrent _) = True +atomicPermIsCopyable Perm_LFinished = True atomicPermIsCopyable (Perm_Struct ps) = and $ RL.mapToList permIsCopyable ps atomicPermIsCopyable (Perm_Fun _) = True atomicPermIsCopyable (Perm_BVProp _) = True @@ -4400,10 +4407,6 @@ lownedPermCouldProve (LOwnedPermBlock (PExpr_Var x) bp) ps = bvRangesCouldOverlap (llvmBlockRange bp) rng _ -> False) $ varAtomicPermsInDistPerms x ps -lownedPermCouldProve (LOwnedPermLifetime (PExpr_Var l) _ ps_out) ps = - any (\case Perm_LOwned _ _ -> True - _ -> False) (varAtomicPermsInDistPerms l ps) || - lownedPermsCouldProve ps_out ps lownedPermCouldProve _ _ = False -- | Test if an 'LOwnedPerms' list could help prove any of a list of permissions @@ -4566,9 +4569,10 @@ instance FreeVars (AtomicPerm tp) where freeVars Perm_IsLLVMPtr = NameSet.empty freeVars (Perm_LLVMBlockShape sh) = freeVars sh freeVars (Perm_LLVMFrame fperms) = freeVars $ map fst fperms - freeVars (Perm_LOwned ps_in ps_out) = - NameSet.union (freeVars ps_in) (freeVars ps_out) + freeVars (Perm_LOwned ls ps_in ps_out) = + NameSet.unions [freeVars ls, freeVars ps_in, freeVars ps_out] freeVars (Perm_LCurrent l) = freeVars l + freeVars Perm_LFinished = NameSet.empty freeVars (Perm_Struct ps) = NameSet.unions $ RL.mapToList freeVars ps freeVars (Perm_Fun fun_perm) = freeVars fun_perm freeVars (Perm_BVProp prop) = freeVars prop @@ -4625,8 +4629,6 @@ instance FreeVars (LOwnedPerm a) where NameSet.unions [freeVars e, freeVars fp] freeVars (LOwnedPermBlock e bp) = NameSet.unions [freeVars e, freeVars bp] - freeVars (LOwnedPermLifetime e ps_in ps_out) = - NameSet.unions [freeVars e, freeVars ps_in, freeVars ps_out] instance FreeVars (LOwnedPerms ps) where freeVars = NameSet.unions . RL.mapToList freeVars @@ -4689,7 +4691,7 @@ instance NeededVars (AtomicPerm a) where neededVars (Perm_LLVMArray ap) = neededVars ap neededVars (Perm_LLVMBlock bp) = neededVars bp neededVars (Perm_LLVMBlockShape _) = NameSet.empty - neededVars p@(Perm_LOwned _ _) = freeVars p + neededVars p@(Perm_LOwned _ _ _) = freeVars p neededVars p = freeVars p instance NeededVars (LLVMFieldPerm w sz) where @@ -4952,9 +4954,10 @@ instance SubstVar s m => Substable s (AtomicPerm a) m where [nuMP| Perm_LLVMBlockShape sh |] -> Perm_LLVMBlockShape <$> genSubst s sh [nuMP| Perm_LLVMFrame fp |] -> Perm_LLVMFrame <$> genSubst s fp - [nuMP| Perm_LOwned ps_in ps_out |] -> - Perm_LOwned <$> genSubst s ps_in <*> genSubst s ps_out + [nuMP| Perm_LOwned ls ps_in ps_out |] -> + Perm_LOwned <$> genSubst s ls <*> genSubst s ps_in <*> genSubst s ps_out [nuMP| Perm_LCurrent e |] -> Perm_LCurrent <$> genSubst s e + [nuMP| Perm_LFinished |] -> return Perm_LFinished [nuMP| Perm_Struct tps |] -> Perm_Struct <$> genSubst s tps [nuMP| Perm_Fun fperm |] -> Perm_Fun <$> genSubst s fperm [nuMP| Perm_BVProp prop |] -> Perm_BVProp <$> genSubst s prop @@ -5078,9 +5081,6 @@ instance SubstVar s m => Substable s (LOwnedPerm a) m where LOwnedPermField <$> genSubst s e <*> genSubst s fp [nuMP| LOwnedPermBlock e bp |] -> LOwnedPermBlock <$> genSubst s e <*> genSubst s bp - [nuMP| LOwnedPermLifetime e ps_in ps_out |] -> - LOwnedPermLifetime <$> genSubst s e <*> genSubst s ps_in - <*> genSubst s ps_out instance SubstVar s m => Substable1 s LOwnedPerm m where genSubst1 = genSubst @@ -5099,9 +5099,9 @@ instance SubstVar PermVarSubst m => Substable PermVarSubst (LifetimeCurrentPerms ps) m where genSubst s mb_x = case mbMatch mb_x of [nuMP| AlwaysCurrentPerms |] -> return AlwaysCurrentPerms - [nuMP| LOwnedCurrentPerms l ps_in ps_out |] -> - LOwnedCurrentPerms <$> genSubst s l <*> genSubst s ps_in - <*> genSubst s ps_out + [nuMP| LOwnedCurrentPerms l ls ps_in ps_out |] -> + LOwnedCurrentPerms <$> genSubst s l <*> genSubst s ls + <*> genSubst s ps_in <*> genSubst s ps_out [nuMP| CurrentTransPerms ps l |] -> CurrentTransPerms <$> genSubst s ps <*> genSubst s l @@ -5703,13 +5703,16 @@ instance AbstractVars (AtomicPerm a) where abstractPEVars ns1 ns2 (Perm_LLVMFrame fp) = absVarsReturnH ns1 ns2 $(mkClosed [| Perm_LLVMFrame |]) `clMbMbApplyM` abstractPEVars ns1 ns2 fp - abstractPEVars ns1 ns2 (Perm_LOwned ps_in ps_out) = + abstractPEVars ns1 ns2 (Perm_LOwned ls ps_in ps_out) = absVarsReturnH ns1 ns2 $(mkClosed [| Perm_LOwned |]) + `clMbMbApplyM` abstractPEVars ns1 ns2 ls `clMbMbApplyM` abstractPEVars ns1 ns2 ps_in `clMbMbApplyM` abstractPEVars ns1 ns2 ps_out abstractPEVars ns1 ns2 (Perm_LCurrent e) = absVarsReturnH ns1 ns2 $(mkClosed [| Perm_LCurrent |]) `clMbMbApplyM` abstractPEVars ns1 ns2 e + abstractPEVars ns1 ns2 Perm_LFinished = + absVarsReturnH ns1 ns2 $(mkClosed [| Perm_LFinished |]) abstractPEVars ns1 ns2 (Perm_Struct ps) = absVarsReturnH ns1 ns2 $(mkClosed [| Perm_Struct |]) `clMbMbApplyM` abstractPEVars ns1 ns2 ps @@ -5839,11 +5842,6 @@ instance AbstractVars (LOwnedPerm a) where absVarsReturnH ns1 ns2 $(mkClosed [| LOwnedPermBlock |]) `clMbMbApplyM` abstractPEVars ns1 ns2 e `clMbMbApplyM` abstractPEVars ns1 ns2 bp - abstractPEVars ns1 ns2 (LOwnedPermLifetime e ps_in ps_out) = - absVarsReturnH ns1 ns2 $(mkClosed [| LOwnedPermLifetime |]) - `clMbMbApplyM` abstractPEVars ns1 ns2 e - `clMbMbApplyM` abstractPEVars ns1 ns2 ps_in - `clMbMbApplyM` abstractPEVars ns1 ns2 ps_out instance AbstractVars (LOwnedPerms ps) where abstractPEVars ns1 ns2 MNil = @@ -6014,9 +6012,11 @@ instance AbstractNamedShape w (AtomicPerm a) where abstractNSM (Perm_NamedConj n args off) = mbMap2 (Perm_NamedConj n) <$> abstractNSM args <*> abstractNSM off abstractNSM (Perm_LLVMFrame fp) = fmap Perm_LLVMFrame <$> abstractNSM fp - abstractNSM (Perm_LOwned ps_in ps_out) = - mbMap2 Perm_LOwned <$> abstractNSM ps_in <*> abstractNSM ps_out + abstractNSM (Perm_LOwned ls ps_in ps_out) = + mbMap3 Perm_LOwned <$> abstractNSM ls <*> abstractNSM ps_in <*> + abstractNSM ps_out abstractNSM (Perm_LCurrent e) = fmap Perm_LCurrent <$> abstractNSM e + abstractNSM Perm_LFinished = pureBindingM Perm_LFinished abstractNSM (Perm_Struct ps) = fmap Perm_Struct <$> abstractNSM ps abstractNSM (Perm_Fun fp) = fmap Perm_Fun <$> abstractNSM fp abstractNSM (Perm_BVProp prop) = pureBindingM (Perm_BVProp prop) @@ -6055,9 +6055,6 @@ instance AbstractNamedShape w (LOwnedPerm a) where mbMap2 LOwnedPermField <$> abstractNSM e <*> abstractNSM fp abstractNSM (LOwnedPermBlock e bp) = mbMap2 LOwnedPermBlock <$> abstractNSM e <*> abstractNSM bp - abstractNSM (LOwnedPermLifetime e ps_in ps_out) = - mbMap3 LOwnedPermLifetime <$> abstractNSM e <*> abstractNSM ps_in - <*> abstractNSM ps_out instance AbstractNamedShape w (ValuePerms as) where abstractNSM ValPerms_Nil = pureBindingM ValPerms_Nil @@ -6545,7 +6542,7 @@ instance GetDetVarsClauses (AtomicPerm a) where getDetVarsClauses (Perm_LLVMBlockShape sh) = getDetVarsClauses sh getDetVarsClauses (Perm_LLVMFrame frame_perm) = concat <$> mapM (getDetVarsClauses . fst) frame_perm - getDetVarsClauses (Perm_LOwned _ _) = return [] + getDetVarsClauses (Perm_LOwned _ _ _) = return [] getDetVarsClauses _ = return [] instance (1 <= w, KnownNat w, 1 <= sz, KnownNat sz) => diff --git a/heapster-saw/src/Verifier/SAW/Heapster/RustTypes.hs b/heapster-saw/src/Verifier/SAW/Heapster/RustTypes.hs index bee75fa0ca..3690d69b7f 100644 --- a/heapster-saw/src/Verifier/SAW/Heapster/RustTypes.hs +++ b/heapster-saw/src/Verifier/SAW/Heapster/RustTypes.hs @@ -990,8 +990,6 @@ abstractMbLOPsModalities mb_lops = case mbMatch mb_lops of LOwnedPermBlock e (bp { llvmBlockRW = PExpr_Var rw, llvmBlockLifetime = PExpr_Var l })) mb_e mb_bp) - [nuMP| lops :>: lop@(LOwnedPermLifetime _ _ _) |] -> - liftA2 (mbMap2 (:>:)) (abstractMbLOPsModalities lops) (pure lop) -- | Find all field or block permissions containing lifetime @l@ and return them diff --git a/heapster-saw/src/Verifier/SAW/Heapster/TypeChecker.hs b/heapster-saw/src/Verifier/SAW/Heapster/TypeChecker.hs index 2579b458b5..59dd836595 100644 --- a/heapster-saw/src/Verifier/SAW/Heapster/TypeChecker.hs +++ b/heapster-saw/src/Verifier/SAW/Heapster/TypeChecker.hs @@ -603,9 +603,10 @@ tcBlockAtomic e = tcError (pos e) "Expected llvmblock perm" -- | Check a lifetime permission literal tcLifetimeAtomic :: AstExpr -> Tc (AtomicPerm LifetimeType) -tcLifetimeAtomic (ExLOwned _ x y) = +tcLifetimeAtomic (ExLOwned _ ls x y) = do Some x' <- tcLOwnedPerms x Some y' <- tcLOwnedPerms y + ls' <- mapM tcKExpr ls pure (Perm_LOwned x' y') tcLifetimeAtomic (ExLCurrent _ l) = Perm_LCurrent <$> tcOptLifetime l tcLifetimeAtomic e = tcError (pos e) "Expected lifetime perm" diff --git a/heapster-saw/src/Verifier/SAW/Heapster/UntypedAST.hs b/heapster-saw/src/Verifier/SAW/Heapster/UntypedAST.hs index c0d553162e..475ae1d3de 100644 --- a/heapster-saw/src/Verifier/SAW/Heapster/UntypedAST.hs +++ b/heapster-saw/src/Verifier/SAW/Heapster/UntypedAST.hs @@ -69,7 +69,7 @@ data AstExpr | ExLessEqual Pos AstExpr AstExpr -- ^ less-than or equal-to bitvector proposition | ExEq Pos AstExpr -- ^ equal permission - | ExLOwned Pos [(Located String, AstExpr)] [(Located String, AstExpr)] -- ^ owned permission + | ExLOwned Pos [AstExpr] [(Located String, AstExpr)] [(Located String, AstExpr)] -- ^ owned permission | ExLCurrent Pos (Maybe AstExpr) -- ^ current permission | ExShape Pos AstExpr -- ^ shape literal | ExFree Pos AstExpr -- ^ free literal @@ -106,7 +106,7 @@ instance HasPos AstExpr where pos (ExNotEqual p _ _ ) = p pos (ExLessThan p _ _ ) = p pos (ExLessEqual p _ _ ) = p - pos (ExLOwned p _ _ ) = p + pos (ExLOwned p _ _ _ ) = p pos (ExLCurrent p _ ) = p pos (ExShape p _ ) = p pos (ExFree p _ ) = p From 71b0535c7efce73e824db974befa04c0829b6879 Mon Sep 17 00:00:00 2001 From: Eddy Westbrook Date: Mon, 2 Aug 2021 17:40:38 -0700 Subject: [PATCH 05/28] bugfix: there was an infinite loop that kept copying a block permission before eliminating it and would then go right back to trying to eliminate that same permission again... --- .../src/Verifier/SAW/Heapster/Implication.hs | 40 +++++++++++-------- 1 file changed, 24 insertions(+), 16 deletions(-) diff --git a/heapster-saw/src/Verifier/SAW/Heapster/Implication.hs b/heapster-saw/src/Verifier/SAW/Heapster/Implication.hs index e2c5a36363..4216ad6df9 100644 --- a/heapster-saw/src/Verifier/SAW/Heapster/Implication.hs +++ b/heapster-saw/src/Verifier/SAW/Heapster/Implication.hs @@ -4005,13 +4005,22 @@ implElimLLVMBlock _ bp = permPretty i (Perm_LLVMBlock bp)) >>>= implFailM --- | Eliminate a @memblock@ permission on the top of the stack and recombine it, --- if this is possible; otherwise fail -implElimPopLLVMBlock :: (1 <= w, KnownNat w, NuMatchingAny1 r) => - ExprVar (LLVMPointerType w) -> LLVMBlockPerm w -> - ImplM vars s r ps (ps :> LLVMPointerType w) () -implElimPopLLVMBlock x bp = - implElimLLVMBlock x bp >>> getTopDistPerm x >>>= \p' -> recombinePerm x p' +-- | Assume the top of the stack contains @x:ps@, which are all the permissions +-- for @x@. Extract the @i@th conjuct from @ps@, which should be a @memblock@ +-- permission, pop the remaining permissions back to @x@, eliminate the +-- @memblock@ permission using 'implElimLLVMBlock' if possible, and recombine +-- all the resulting permissions. If the block permission cannot be elimnated, +-- then fail. +implElimPopIthLLVMBlock :: (1 <= w, KnownNat w, NuMatchingAny1 r) => + ExprVar (LLVMPointerType w) -> + [AtomicPerm (LLVMPointerType w)] -> Int -> + ImplM vars s r ps (ps :> LLVMPointerType w) () +implElimPopIthLLVMBlock x ps i + | i < length ps + , Perm_LLVMBlock bp <- ps!!i = + implExtractConjM x ps i >>> implPopM x (ValPerm_Conj $ deleteNth i ps) >>> + implElimLLVMBlock x bp >>> getTopDistPerm x >>>= \p' -> recombinePerm x p' +implElimPopIthLLVMBlock _ _ _ = error "implElimPopIthLLVMBlock: malformed inputs" ---------------------------------------------------------------------- @@ -4629,9 +4638,8 @@ proveVarLLVMField :: -- Special case: if the LHS is a memblock perm, unfold it and prove again proveVarLLVMField x ps i _ mb_fp - | Perm_LLVMBlock bp <- ps!!i = - implExtractConjM x ps i >>> implPopM x (ValPerm_Conj $ deleteNth i ps) >>> - implElimPopLLVMBlock x bp >>> + | Perm_LLVMBlock _ <- ps!!i = + implElimPopIthLLVMBlock x ps i >>> proveVarImplInt x (fmap (ValPerm_Conj1 . Perm_LLVMField) mb_fp) proveVarLLVMField x ps i off mb_fp = @@ -4878,8 +4886,8 @@ proveVarLLVMArrayH x _ ps ap -- eliminate that memblock permission and try again proveVarLLVMArrayH x _ ps ap | Just i <- findIndex (isLLVMAtomicPermWithOffset $ llvmArrayOffset ap) ps - , Perm_LLVMBlock bp <- ps!!i = - implGetPopConjM x ps i >>> implElimPopLLVMBlock x bp >>> + , Perm_LLVMBlock _ <- ps!!i = + implElimPopIthLLVMBlock x ps i >>> mbVarsM (ValPerm_LLVMArray ap) >>>= \mb_p -> proveVarImplInt x mb_p @@ -5423,8 +5431,8 @@ proveVarLLVMBlocks' x ps psubst mb_bps_in mb_ps = case mbMatch mb_bps_in of p@(Perm_LLVMBlock _) -> isJust (llvmPermContainsOffset off p) _ -> False) ps - , Perm_LLVMBlock bp <- ps!!i -> - implGetPopConjM x ps i >>> implElimPopLLVMBlock x bp >>> + , Perm_LLVMBlock _ <- ps!!i -> + implElimPopIthLLVMBlock x ps i >>> proveVarImplInt x (fmap ValPerm_Conj $ mbMap2 (++) (fmap (map Perm_LLVMBlock) $ mbMap2 (:) mb_bp mb_bps) @@ -5484,8 +5492,8 @@ proveVarLLVMBlocks' x ps psubst mb_bps_in mb_ps = case mbMatch mb_bps_in of p@(Perm_LLVMBlock _) -> isJust (llvmPermContainsOffset off p) _ -> False) ps - , Perm_LLVMBlock bp <- ps!!i -> - implGetPopConjM x ps i >>> implElimPopLLVMBlock x bp >>> + , Perm_LLVMBlock _ <- ps!!i -> + implElimPopIthLLVMBlock x ps i >>> proveVarImplInt x (fmap ValPerm_Conj $ mbMap2 (++) (fmap (map Perm_LLVMBlock) $ mbMap2 (:) mb_bp mb_bps) From ffc7e853d95e458ec6053a7b16b1cb6e93b94a03 Mon Sep 17 00:00:00 2001 From: Eddy Westbrook Date: Tue, 3 Aug 2021 11:20:52 -0700 Subject: [PATCH 06/28] added debug output for return statements, which is long overdue --- .../src/Verifier/SAW/Heapster/TypedCrucible.hs | 17 ++++++++++++++--- 1 file changed, 14 insertions(+), 3 deletions(-) diff --git a/heapster-saw/src/Verifier/SAW/Heapster/TypedCrucible.hs b/heapster-saw/src/Verifier/SAW/Heapster/TypedCrucible.hs index 055c2324ff..cd4b589cb5 100644 --- a/heapster-saw/src/Verifier/SAW/Heapster/TypedCrucible.hs +++ b/heapster-saw/src/Verifier/SAW/Heapster/TypedCrucible.hs @@ -2877,14 +2877,16 @@ tcEmitStmt :: StmtPermCheckM ext cblocks blocks tops ret RNil RNil (CtxTrans ctx') tcEmitStmt ctx loc stmt = do _ <- stmtTraceM (const (pretty "Type-checking statement:" <+> - ppStmt (size ctx) stmt)) + ppStmt (size ctx) stmt)) !_ <- permGetPPInfo !pps <- mapM (\(Some r) -> ppCruRegAndPerms ctx r) (stmtInputRegs stmt) - !_ <- stmtTraceM (\_-> pretty "Input perms:" <> softline <> ppCommaSep pps) + !_ <- stmtTraceM (\_-> pretty "Input perms:" <> softline <> + ppCommaSep pps) !ctx' <- tcEmitStmt' ctx loc stmt !pps' <- mapM (\(Some r) -> ppCruRegAndPerms ctx' r) (stmtOutputRegs (Ctx.size ctx') stmt) - _ <- stmtTraceM (const (pretty "Output perms:" <> softline <> ppCommaSep pps')) + _ <- stmtTraceM (const (pretty "Output perms:" <> softline <> + ppCommaSep pps')) pure ctx' @@ -3846,6 +3848,15 @@ tcTermStmt ctx (Return reg) = req_perms = varSubst (singletonVarSubst $ typedRegVar treg) mb_ret_perms err = ppProofError (stPPInfo st) req_perms in + mapM (\(Some x) -> ppRelevantPerms $ TypedReg x) (RL.mapToList Some $ + distPermsVars req_perms) + >>>= \pps_before -> + stmtTraceM (\i -> + pretty "Type-checking return statement" <> line <> + pretty "Current perms:" <> softline <> + ppCommaSep pps_before <> line <> + pretty "Required perms:" <> softline <> + permPretty i req_perms) >>> TypedReturn <$> pcmRunImplM CruCtxNil err (const $ TypedRet Refl (stRetType top_st) treg mb_ret_perms) From f41437b67c96e7be5b5a23d91eb5c8ce20dd527e Mon Sep 17 00:00:00 2001 From: Eddy Westbrook Date: Tue, 3 Aug 2021 11:24:06 -0700 Subject: [PATCH 07/28] changed implElimLLVMBlock to always only eliminate one step of a memblock permission; changed proveVarLLVMBlocks to focus first on eliminating memblock permissions on the left that overlap with but are not contained in memblock permissions on the right --- .../src/Verifier/SAW/Heapster/Implication.hs | 107 ++++++++++++------ 1 file changed, 75 insertions(+), 32 deletions(-) diff --git a/heapster-saw/src/Verifier/SAW/Heapster/Implication.hs b/heapster-saw/src/Verifier/SAW/Heapster/Implication.hs index 4216ad6df9..1456ace45c 100644 --- a/heapster-saw/src/Verifier/SAW/Heapster/Implication.hs +++ b/heapster-saw/src/Verifier/SAW/Heapster/Implication.hs @@ -3929,8 +3929,8 @@ implIntroLLVMBlockNamed _ _ = error "implIntroLLVMBlockNamed: malformed permission" -- | Eliminate a @memblock@ permission on the top of the stack, if possible, --- otherwise fail. The elimination does not have to completely remove any --- @memblock@ permission, it just needs to make some sort of progress. +-- otherwise fail. Specifically, this means to perform one step of @memblock@ +-- elimination, depening on the shape of the @memblock@ permission. implElimLLVMBlock :: (1 <= w, KnownNat w, NuMatchingAny1 r) => ExprVar (LLVMPointerType w) -> LLVMBlockPerm w -> ImplM vars s r (ps :> LLVMPointerType w) @@ -3947,36 +3947,25 @@ implElimLLVMBlock x bp implElimLLVMBlock x bp@(LLVMBlockPerm { llvmBlockShape = PExpr_NamedShape rw l nmsh args }) | TrueRepr <- namedShapeCanUnfoldRepr nmsh - , Just sh' <- unfoldModalizeNamedShape rw l nmsh args = + , isJust (unfoldModalizeNamedShape rw l nmsh args) = (if namedShapeIsRecursive nmsh then implSetRecRecurseLeftM else pure ()) >>> - implSimplM Proxy (SImpl_ElimLLVMBlockNamed x bp nmsh) >>> - implElimLLVMBlock x (bp { llvmBlockShape = sh' }) + implSimplM Proxy (SImpl_ElimLLVMBlockNamed x bp nmsh) implElimLLVMBlock x bp@(LLVMBlockPerm { llvmBlockShape = PExpr_EqShape (PExpr_Var y) }) = - -- For shape eqsh(y), prove y:block(sh) for some sh, and apply - -- SImpl_IntroLLVMBlockFromEq, and then recursively eliminate the resulting - -- memblock permission, unless the resulting shape cannot be eliminated, in - -- which case we have still made progress so we can just stop + -- For shape eqsh(y), prove y:block(sh) for some sh and then apply + -- SImpl_IntroLLVMBlockFromEq mbVarsM () >>>= \mb_unit -> withExtVarsM (proveVarImplInt y $ mbCombine RL.typeCtxProxies $ flip fmap mb_unit $ const $ nu $ \sh -> ValPerm_Conj1 $ Perm_LLVMBlockShape $ PExpr_Var sh) >>>= \(_, sh) -> let bp' = bp { llvmBlockShape = sh } in - implSimplM Proxy (SImpl_IntroLLVMBlockFromEq x bp' y) >>> - case sh of - PExpr_NamedShape _ _ nmsh _ - | not (namedShapeCanUnfold nmsh) -> - -- Opaque shapes cannot be further eliminated, so stop - return () - _ -> implElimLLVMBlock x bp' + implSimplM Proxy (SImpl_IntroLLVMBlockFromEq x bp' y) implElimLLVMBlock x bp@(LLVMBlockPerm { llvmBlockShape = PExpr_PtrShape maybe_rw maybe_l sh }) | Just len <- llvmShapeLength sh = let bp' = bp { llvmBlockLen = len, llvmBlockShape = sh } in implSimplM Proxy (SImpl_ElimLLVMBlockPtr x maybe_rw maybe_l bp') - -- NOTE: no need to recurse in this case, because we have a normal pointer - -- permission on x (even though its contents are a memblock permission) implElimLLVMBlock x (LLVMBlockPerm { llvmBlockShape = PExpr_FieldShape (LLVMFieldShape p) , ..}) = @@ -4023,6 +4012,35 @@ implElimPopIthLLVMBlock x ps i implElimPopIthLLVMBlock _ _ _ = error "implElimPopIthLLVMBlock: malformed inputs" +-- | Assume the top of the stack contains @x:p1*...*pn@, which are all the +-- permissions for @x@. Extract the @i@th conjuct @pi@, which should be a +-- @memblock@ permission. Eliminate that @memblock@ permission using +-- 'implElimLLVMBlock' if possible to atomic permissions @x:q1*...*qm@, and +-- append the resulting atomic permissions @qi@ to the top of the stack, leaving +-- +-- > x:ps1 * ... * pi-1 * pi+1 * ... * pn * q1 * ... * qm +-- +-- on top of the stack. Return the list of atomic permissions that are now on +-- top of the stack. If the @memblock@ permission @pi@ cannot be elimnated, then +-- fail. +implElimAppendIthLLVMBlock :: (1 <= w, KnownNat w, NuMatchingAny1 r) => + ExprVar (LLVMPointerType w) -> + [AtomicPerm (LLVMPointerType w)] -> Int -> + ImplM vars s r (ps :> LLVMPointerType w) + (ps :> LLVMPointerType w) + [AtomicPerm (LLVMPointerType w)] +implElimAppendIthLLVMBlock x ps i + | i < length ps , Perm_LLVMBlock bp <- ps!!i = + implExtractSwapConjM x ps i >>> implElimLLVMBlock x bp >>> + elimOrsExistsM x >>>= \case + (ValPerm_Conj ps') -> + implAppendConjsM x (deleteNth i ps) ps' >>> return (deleteNth i ps ++ ps') + _ -> error ("implElimAppendIthLLVMBlock: unexpected non-conjunctive perm " + ++ "returned by implElimLLVMBlock") +implElimAppendIthLLVMBlock _ _ _ = + error "implElimAppendIthLLVMBlock: malformed inputs" + + ---------------------------------------------------------------------- -- * Support for Proving Lifetimes Are Current ---------------------------------------------------------------------- @@ -5245,8 +5263,22 @@ proveVarLLVMBlocksExt2 x ps psubst mb_bps_ext mb_bps mb_ps = pure (e1,e2) --- | The "real" version of 'proveVarLLVMBlocks'; that function is just a debug --- printing wrapper around this one +-- | The "real" version of 'proveVarLLVMBlocks'. That function is just a debug +-- printing wrapper around this one. +-- +-- A central motivation of this algorithm is to do as little elimination on the +-- left or introduction on the right as possible, in order to build the smallest +-- derivation we can. The algorithm iterates through the block permissions on +-- the right, trying for each of them to either match it up with a block +-- permission on the left or simplify it to a non-block permission. The first +-- stage of the algorithm attempts to break down permissions on the left that +-- overlap with but are not contained in the current block permission on the +-- right we are trying to prove, so that we end up with permissions on the left +-- that are no bigger than the right. It then repeatedly breaks down the +-- right-hand block permission we are trying to prove, going back to stage one +-- if necessary if this leads to it being smaller than some left-hand +-- permission, until we either get a precise match or we eventually break the +-- right-hand permission down to a non-block permission. proveVarLLVMBlocks' :: (1 <= w, KnownNat w, NuMatchingAny1 r) => ExprVar (LLVMPointerType w) -> [AtomicPerm (LLVMPointerType w)] -> PartialSubst vars -> @@ -5307,6 +5339,22 @@ proveVarLLVMBlocks' x ps psubst mb_bps_in mb_ps = case mbMatch mb_bps_in of implInsertConjM x (Perm_LLVMBlock bp'') ps_out 0 + -- If there is a left-hand permission whose range overlaps with but is not + -- contained in that of mb_bp, eliminate it + [nuMP| mb_bp : _ |] + | Just off <- partialSubst psubst $ fmap llvmBlockOffset mb_bp + , Just len <- partialSubst psubst $ fmap llvmBlockLen mb_bp + , rng <- BVRange off len + , Just i <- findIndex (\case + Perm_LLVMBlock bp -> + bvRangesCouldOverlap (llvmBlockRange bp) rng && + not (bvRangeSubset (llvmBlockRange bp) rng) + _ -> False) ps + , isLLVMBlockPerm (ps!!i) -> + implElimAppendIthLLVMBlock x ps i >>>= \ps' -> + proveVarLLVMBlocks x ps' psubst mb_bps_in mb_ps + + -- If proving the empty shape for length 0, recursively prove everything else -- and then use the empty introduction rule [nuMP| mb_bp : mb_bps |] @@ -5423,7 +5471,7 @@ proveVarLLVMBlocks' x ps psubst mb_bps_in mb_ps = case mbMatch mb_bps_in of -- permission on the left with this exact offset, length, and shape, because -- it would have matched some previous case, so try to eliminate a memblock -- and recurse - [nuMP| mb_bp : mb_bps |] + [nuMP| mb_bp : _ |] | [nuMP| PExpr_NamedShape _ _ nmsh _ |] <- mbMatch $ fmap llvmBlockShape mb_bp , [nuMP| FalseRepr |] <- mbMatch $ fmap namedShapeCanUnfoldRepr nmsh , Just off <- partialSubst psubst $ fmap llvmBlockOffset mb_bp @@ -5432,11 +5480,8 @@ proveVarLLVMBlocks' x ps psubst mb_bps_in mb_ps = case mbMatch mb_bps_in of isJust (llvmPermContainsOffset off p) _ -> False) ps , Perm_LLVMBlock _ <- ps!!i -> - implElimPopIthLLVMBlock x ps i >>> - proveVarImplInt x (fmap ValPerm_Conj $ - mbMap2 (++) - (fmap (map Perm_LLVMBlock) $ mbMap2 (:) mb_bp mb_bps) - mb_ps) + implElimAppendIthLLVMBlock x ps i >>>= \ps' -> + proveVarLLVMBlocks x ps' psubst mb_bps_in mb_ps -- If proving an equality shape eqsh(z) for evar z which has already been set, @@ -5484,7 +5529,7 @@ proveVarLLVMBlocks' x ps psubst mb_bps_in mb_ps = case mbMatch mb_bps_in of -- have it on the left, but we don't have a memblock permission on the left with -- this exactly offset, length, and shape, because it would have matched the -- first case above, so try to eliminate a memblock and recurse - [nuMP| mb_bp : mb_bps |] + [nuMP| mb_bp : _ |] | [nuMP| PExpr_EqShape (PExpr_Var mb_z) |] <- mbMatch $ fmap llvmBlockShape mb_bp , Right _ <- mbNameBoundP mb_z , Just off <- partialSubst psubst $ fmap llvmBlockOffset mb_bp @@ -5493,11 +5538,9 @@ proveVarLLVMBlocks' x ps psubst mb_bps_in mb_ps = case mbMatch mb_bps_in of isJust (llvmPermContainsOffset off p) _ -> False) ps , Perm_LLVMBlock _ <- ps!!i -> - implElimPopIthLLVMBlock x ps i >>> - proveVarImplInt x (fmap ValPerm_Conj $ - mbMap2 (++) - (fmap (map Perm_LLVMBlock) $ mbMap2 (:) mb_bp mb_bps) - mb_ps) + implElimAppendIthLLVMBlock x ps i >>>= \ps' -> + proveVarLLVMBlocks x ps' psubst mb_bps_in mb_ps + -- If proving a pointer shape, prove the required permission by adding it to ps; -- this requires the pointed-to shape to have a well-defined length From 465194b08a954add15b34827d0b9df7c8701e577 Mon Sep 17 00:00:00 2001 From: Eddy Westbrook Date: Tue, 3 Aug 2021 13:22:29 -0700 Subject: [PATCH 08/28] unfold defined shapes on the left when their ranges match a shape we are trying to prove on the right --- .../src/Verifier/SAW/Heapster/Implication.hs | 21 +++++++++++++++++-- 1 file changed, 19 insertions(+), 2 deletions(-) diff --git a/heapster-saw/src/Verifier/SAW/Heapster/Implication.hs b/heapster-saw/src/Verifier/SAW/Heapster/Implication.hs index 1456ace45c..cd5e197465 100644 --- a/heapster-saw/src/Verifier/SAW/Heapster/Implication.hs +++ b/heapster-saw/src/Verifier/SAW/Heapster/Implication.hs @@ -5339,6 +5339,24 @@ proveVarLLVMBlocks' x ps psubst mb_bps_in mb_ps = case mbMatch mb_bps_in of implInsertConjM x (Perm_LLVMBlock bp'') ps_out 0 + -- If the offset and length of the top block matches one that we already have + -- on the left, but the left-hand permission has a defined shape, unfold the + -- defined shape + [nuMP| mb_bp : _ |] + | Just off <- partialSubst psubst $ fmap llvmBlockOffset mb_bp + , Just len <- partialSubst psubst $ fmap llvmBlockLen mb_bp + , Just i <- findIndex + (\case + Perm_LLVMBlock bp + | PExpr_NamedShape _ _ nmsh _ <- llvmBlockShape bp + , DefinedShapeBody _ <- namedShapeBody nmsh -> + bvEq (llvmBlockOffset bp) off && + bvEq (llvmBlockLen bp) len + _ -> False) ps -> + implElimAppendIthLLVMBlock x ps i >>>= \ps' -> + proveVarLLVMBlocks x ps' psubst mb_bps_in mb_ps + + -- If there is a left-hand permission whose range overlaps with but is not -- contained in that of mb_bp, eliminate it [nuMP| mb_bp : _ |] @@ -5349,8 +5367,7 @@ proveVarLLVMBlocks' x ps psubst mb_bps_in mb_ps = case mbMatch mb_bps_in of Perm_LLVMBlock bp -> bvRangesCouldOverlap (llvmBlockRange bp) rng && not (bvRangeSubset (llvmBlockRange bp) rng) - _ -> False) ps - , isLLVMBlockPerm (ps!!i) -> + _ -> False) ps -> implElimAppendIthLLVMBlock x ps i >>>= \ps' -> proveVarLLVMBlocks x ps' psubst mb_bps_in mb_ps From aa63297f253d0174727b85a1db948c385718f78a Mon Sep 17 00:00:00 2001 From: Eddy Westbrook Date: Tue, 3 Aug 2021 13:45:37 -0700 Subject: [PATCH 09/28] whoops, do not try to eliminate LHS block perms when we are proving an empty block perm on the right --- heapster-saw/src/Verifier/SAW/Heapster/Implication.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/heapster-saw/src/Verifier/SAW/Heapster/Implication.hs b/heapster-saw/src/Verifier/SAW/Heapster/Implication.hs index cd5e197465..c85b0a0db6 100644 --- a/heapster-saw/src/Verifier/SAW/Heapster/Implication.hs +++ b/heapster-saw/src/Verifier/SAW/Heapster/Implication.hs @@ -5358,10 +5358,12 @@ proveVarLLVMBlocks' x ps psubst mb_bps_in mb_ps = case mbMatch mb_bps_in of -- If there is a left-hand permission whose range overlaps with but is not - -- contained in that of mb_bp, eliminate it + -- contained in that of mb_bp, eliminate it. Note that we exclude mb_bp with 0 + -- length for this case. [nuMP| mb_bp : _ |] | Just off <- partialSubst psubst $ fmap llvmBlockOffset mb_bp , Just len <- partialSubst psubst $ fmap llvmBlockLen mb_bp + , not (bvIsZero len) , rng <- BVRange off len , Just i <- findIndex (\case Perm_LLVMBlock bp -> From 9f27cc63d4b3ecdcca0923d6806411f4720c48bb Mon Sep 17 00:00:00 2001 From: Eddy Westbrook Date: Wed, 4 Aug 2021 13:42:05 -0700 Subject: [PATCH 10/28] added a case to proveVarLLVMBlocks to detect if the right-hand side is a tagged union type where we already know from something on the left what the tag is, in which case we can avoid searching for proofs of all the disjuncts other than the one that matches that known tag --- .../src/Verifier/SAW/Heapster/Implication.hs | 59 ++++++++++++- .../src/Verifier/SAW/Heapster/Permissions.hs | 82 +++++++++++++++++++ 2 files changed, 140 insertions(+), 1 deletion(-) diff --git a/heapster-saw/src/Verifier/SAW/Heapster/Implication.hs b/heapster-saw/src/Verifier/SAW/Heapster/Implication.hs index c85b0a0db6..7e7f43e843 100644 --- a/heapster-saw/src/Verifier/SAW/Heapster/Implication.hs +++ b/heapster-saw/src/Verifier/SAW/Heapster/Implication.hs @@ -4040,6 +4040,34 @@ implElimAppendIthLLVMBlock x ps i implElimAppendIthLLVMBlock _ _ _ = error "implElimAppendIthLLVMBlock: malformed inputs" +-- | Prove a @memblock@ permission with shape @sh1 orsh sh2 orsh ... orsh shn@ +-- from one with shape @shi@. +implIntroOrShapeMultiM :: (NuMatchingAny1 r, 1 <= w, KnownNat w) => + ExprVar (LLVMPointerType w) -> LLVMBlockPerm w -> + [PermExpr (LLVMShapeType w)] -> Int -> + ImplM vars s r (ps :> LLVMPointerType w) + (ps :> LLVMPointerType w) () +-- Special case: if we take the or of a single shape, it is that shape itself, +-- so we don't need to do anything +implIntroOrShapeMultiM _x _bp [_sh] 0 = return () +implIntroOrShapeMultiM x bp (sh1 : shs) 0 = + let sh2 = foldr1 PExpr_OrShape shs in + introOrLM x + (ValPerm_LLVMBlock $ bp { llvmBlockShape = sh1 }) + (ValPerm_LLVMBlock $ bp { llvmBlockShape = sh2 }) >>> + implSimplM Proxy (SImpl_IntroLLVMBlockOr + x (bp { llvmBlockShape = sh1 }) sh2) +implIntroOrShapeMultiM x bp (sh1 : shs) i = + implIntroOrShapeMultiM x bp shs (i-1) >>> + let sh2 = foldr1 PExpr_OrShape shs in + introOrRM x + (ValPerm_LLVMBlock $ bp { llvmBlockShape = sh1 }) + (ValPerm_LLVMBlock $ bp { llvmBlockShape = sh2 }) >>> + implSimplM Proxy (SImpl_IntroLLVMBlockOr + x (bp { llvmBlockShape = sh1 }) sh2) +implIntroOrShapeMultiM _ _ _ _ = error "implIntroOrShapeMultiM" + + ---------------------------------------------------------------------- -- * Support for Proving Lifetimes Are Current @@ -5468,7 +5496,7 @@ proveVarLLVMBlocks' x ps psubst mb_bps_in mb_ps = case mbMatch mb_bps_in of let mb_bps' = mbMap3 (\bp sh' bps -> (bp { llvmBlockShape = sh' } : bps)) mb_bp mb_sh' mb_bps in - proveVarLLVMBlocks' x ps psubst mb_bps' mb_ps >>> + proveVarLLVMBlocks x ps psubst mb_bps' mb_ps >>> -- Extract out the block perm we proved getTopDistPerm x >>>= \(ValPerm_Conj ps_out) -> @@ -5680,6 +5708,35 @@ proveVarLLVMBlocks' x ps psubst mb_bps_in mb_ps = case mbMatch mb_bps_in of implSwapInsertConjM x (Perm_LLVMBlock bp) ps'' 0 + -- If proving a tagged union shape where we have an equality permission on the + -- left that matches one of the disjuncts, prove that disjunct and or it up + -- with the other disjuncts + [nuMP| mb_bp : mb_bps |] + | [nuMP| Just mb_tag_u |] <- mbMatch $ fmap (asTaggedUnionShape + . llvmBlockShape) mb_bp + , Just off <- partialSubst psubst $ fmap llvmBlockOffset mb_bp + , Just i <- mbLift $ fmap (findTaggedUnionIndexForPerms off ps) mb_tag_u + , mb_shs <- fmap taggedUnionDisjs mb_tag_u + , mb_sh <- fmap (!!i) mb_shs -> + + -- Recursively prove the ith disjunct + proveVarLLVMBlocks x ps psubst (mbMap3 + (\bp sh bps -> + bp { llvmBlockShape = sh } : bps) + mb_bp mb_sh mb_bps) mb_ps >>> + + -- Move the block permission with shape mb_sh to the top of the stack + getTopDistPerm x >>>= \(ValPerm_Conj ps') -> + implExtractSwapConjM x ps' 0 >>> + + -- Finally, weaken the block permission to be the desired tagged union + -- shape, and move it back into position + partialSubstForceM mb_shs "proveVarLLVMBlock" >>>= \shs -> + partialSubstForceM mb_bp "proveVarLLVMBlock" >>>= \bp -> + implIntroOrShapeMultiM x bp shs i >>> + implSwapInsertConjM x (Perm_LLVMBlock bp) (tail ps') 0 + + -- If proving a disjunctive shape, try to prove one of the disjuncts [nuMP| mb_bp : mb_bps |] | [nuMP| PExpr_OrShape mb_sh1 mb_sh2 |] <- mbMatch $ fmap llvmBlockShape mb_bp -> diff --git a/heapster-saw/src/Verifier/SAW/Heapster/Permissions.hs b/heapster-saw/src/Verifier/SAW/Heapster/Permissions.hs index b33ce4e0ff..33ef9d8d63 100644 --- a/heapster-saw/src/Verifier/SAW/Heapster/Permissions.hs +++ b/heapster-saw/src/Verifier/SAW/Heapster/Permissions.hs @@ -33,6 +33,7 @@ import Data.Char (isDigit) import Data.Maybe import Data.List hiding (sort) import Data.List.NonEmpty (NonEmpty(..)) +import qualified Data.List.NonEmpty as NonEmpty import Data.String import Data.Proxy import Data.Reflection @@ -2787,6 +2788,7 @@ $(mkNuMatching [t| forall args a. LifetimeFunctor args a |]) $(mkNuMatching [t| forall ps. LifetimeCurrentPerms ps |]) + instance NuMatchingAny1 LOwnedPerm where nuMatchingAny1Proof = nuMatchingProof @@ -3507,6 +3509,85 @@ remLLVMBLockPermRange rng bp = else return bp' return (bps_l ++ [bp_r]) + +-- | A tagged union shape is a shape of the form +-- +-- > sh1 orsh sh2 orsh ... orsh shn +-- +-- where each @shi@ is equivalent up to associativity of the @;@ operator to a +-- shape of the form +-- +-- > fieldsh(eq(llvmword(bvi)));shi' +-- +-- That is, each disjunct of the shape starts with an equality permission that +-- determines which disjunct should be used. These shapes are represented as a +-- list of the disjuncts, which are tagged with the bitvector values @bvi@ used +-- in the equality permission. +data TaggedUnionShape w + = forall sz. (1 <= sz, KnownNat sz) => + TaggedUnionShape (NonEmpty (BV sz, PermExpr (LLVMShapeType w))) + +-- | Extract the disjunctive shapes from a 'TaggedUnionShape' +taggedUnionDisjs :: TaggedUnionShape w -> [PermExpr (LLVMShapeType w)] +taggedUnionDisjs (TaggedUnionShape disjs) = + snd $ unzip $ NonEmpty.toList disjs + +-- | Convert a 'TaggedUnionShape' to the shape it represents +taggedUnionToShape :: TaggedUnionShape w -> PermExpr (LLVMShapeType w) +taggedUnionToShape (TaggedUnionShape disjs) = + foldr1 PExpr_OrShape $ NonEmpty.map snd disjs + +-- | A bitvector value of some unknown size +data SomeBV = forall sz. (1 <= sz, KnownNat sz) => SomeBV (BV sz) + +-- | Test if a shape is of the form @fieldsh(eq(llvmword(bv)))@ for some @bv@. +-- If so, return @bv@. +shapeToTag :: PermExpr (LLVMShapeType w) -> Maybe SomeBV +shapeToTag (PExpr_FieldShape + (LLVMFieldShape + (ValPerm_Eq (PExpr_LLVMWord (PExpr_BV [] bv))))) = + Just (SomeBV bv) +shapeToTag _ = Nothing + +-- | Test if a shape begins with an equality permission to a bitvector value and +-- return that bitvector value +getShapeBVTag :: PermExpr (LLVMShapeType w) -> Maybe SomeBV +getShapeBVTag sh | Just some_bv <- shapeToTag sh = Just some_bv +getShapeBVTag (PExpr_SeqShape sh1 _) = getShapeBVTag sh1 +getShapeBVTag _ = Nothing + +-- | Test if a shape is a tagged union shape and, if so, convert it to the +-- 'TaggedUnionShape' representation +asTaggedUnionShape :: PermExpr (LLVMShapeType w) -> Maybe (TaggedUnionShape w) +asTaggedUnionShape (PExpr_OrShape sh1 sh2) + | Just (SomeBV bv1) <- getShapeBVTag sh1 + , Just (TaggedUnionShape disjs2@((bv2,_) :| _)) <- asTaggedUnionShape sh2 + , Just Refl <- testEquality (natRepr bv1) (natRepr bv2) = + Just (TaggedUnionShape (NonEmpty.cons (bv1,sh1) disjs2)) +asTaggedUnionShape sh + | Just (SomeBV bv) <- getShapeBVTag sh = + Just (TaggedUnionShape ((bv,sh) :| [])) +asTaggedUnionShape _ = Nothing + +-- | Find a disjunct in a 'TaggedUnionShape' that could be proven at the given +-- offset from the given atomic permissions, by looking for a field or block +-- permission containing an equality permission to one of the tags. If some +-- disjunct can be proved, return its index in the list of disjuncts. +findTaggedUnionIndexForPerms :: PermExpr (BVType w) -> + [AtomicPerm (LLVMPointerType w)] -> + TaggedUnionShape w -> Maybe Int +findTaggedUnionIndexForPerms off (p : _) (TaggedUnionShape disjs@((bv1,_) :| _)) + | Just bp <- llvmAtomicPermToBlock p + , bvEq off (llvmBlockOffset bp) + , Just (SomeBV tag_bv) <- getShapeBVTag $ llvmBlockShape bp + , Just Refl <- testEquality (natRepr tag_bv) (natRepr bv1) + , Just i <- findIndex (== tag_bv) $ fst $ unzip $ NonEmpty.toList disjs + = Just i +findTaggedUnionIndexForPerms off (_ : ps) tag_u = + findTaggedUnionIndexForPerms off ps tag_u +findTaggedUnionIndexForPerms _ [] _ = Nothing + + -- | Convert an array cell number @cell@ to the byte offset for that cell, given -- by @stride * cell + field_num@ llvmArrayCellToOffset :: (1 <= w, KnownNat w) => LLVMArrayPerm w -> @@ -6152,6 +6233,7 @@ data PermEnv = PermEnv { permEnvHints :: [Hint] } +$(mkNuMatching [t| forall w. TaggedUnionShape w |]) $(mkNuMatching [t| forall ctx. PermVarSubst ctx |]) $(mkNuMatching [t| PermEnvFunEntry |]) $(mkNuMatching [t| SomeNamedPerm |]) From 413ff469d54ca29f73b0accf89266d4634f1bfd8 Mon Sep 17 00:00:00 2001 From: Eddy Westbrook Date: Wed, 4 Aug 2021 15:43:12 -0700 Subject: [PATCH 11/28] added another special case to proveVarLLVMBlocks, to eliminate a sequence shape sh;emptysh with the empty shape when necessary --- .../src/Verifier/SAW/Heapster/Implication.hs | 63 +++++++++++++++++-- 1 file changed, 59 insertions(+), 4 deletions(-) diff --git a/heapster-saw/src/Verifier/SAW/Heapster/Implication.hs b/heapster-saw/src/Verifier/SAW/Heapster/Implication.hs index 7e7f43e843..419ad2ef39 100644 --- a/heapster-saw/src/Verifier/SAW/Heapster/Implication.hs +++ b/heapster-saw/src/Verifier/SAW/Heapster/Implication.hs @@ -3928,6 +3928,7 @@ implIntroLLVMBlockNamed x bp implIntroLLVMBlockNamed _ _ = error "implIntroLLVMBlockNamed: malformed permission" + -- | Eliminate a @memblock@ permission on the top of the stack, if possible, -- otherwise fail. Specifically, this means to perform one step of @memblock@ -- elimination, depening on the shape of the @memblock@ permission. @@ -3935,15 +3936,20 @@ implElimLLVMBlock :: (1 <= w, KnownNat w, NuMatchingAny1 r) => ExprVar (LLVMPointerType w) -> LLVMBlockPerm w -> ImplM vars s r (ps :> LLVMPointerType w) (ps :> LLVMPointerType w) () + +-- Eliminate the empty shape to an array of bytes implElimLLVMBlock x bp@(LLVMBlockPerm { llvmBlockShape = PExpr_EmptyShape }) = implSimplM Proxy (SImpl_ElimLLVMBlockToBytes x bp) + +-- If the "natural" length of the shape of a memblock permission is smaller than +-- its actual length, sequence with the empty shape and then eliminate implElimLLVMBlock x bp | Just sh_len <- llvmShapeLength $ llvmBlockShape bp , bvLt sh_len $ llvmBlockLen bp = - -- If the "natural" length of the shape of a memblock permission is smaller - -- than its actual length, sequence with the empty shape and then eliminate implSimplM Proxy (SImpl_IntroLLVMBlockSeqEmpty x bp) >>> implSimplM Proxy (SImpl_ElimLLVMBlockSeq x bp PExpr_EmptyShape) + +-- Unfold defined or recursive named shapes implElimLLVMBlock x bp@(LLVMBlockPerm { llvmBlockShape = PExpr_NamedShape rw l nmsh args }) | TrueRepr <- namedShapeCanUnfoldRepr nmsh @@ -3951,21 +3957,26 @@ implElimLLVMBlock x bp@(LLVMBlockPerm { llvmBlockShape = (if namedShapeIsRecursive nmsh then implSetRecRecurseLeftM else pure ()) >>> implSimplM Proxy (SImpl_ElimLLVMBlockNamed x bp nmsh) + +-- For shape eqsh(y), prove y:block(sh) for some sh and then apply +-- SImpl_IntroLLVMBlockFromEq implElimLLVMBlock x bp@(LLVMBlockPerm { llvmBlockShape = PExpr_EqShape (PExpr_Var y) }) = - -- For shape eqsh(y), prove y:block(sh) for some sh and then apply - -- SImpl_IntroLLVMBlockFromEq mbVarsM () >>>= \mb_unit -> withExtVarsM (proveVarImplInt y $ mbCombine RL.typeCtxProxies $ flip fmap mb_unit $ const $ nu $ \sh -> ValPerm_Conj1 $ Perm_LLVMBlockShape $ PExpr_Var sh) >>>= \(_, sh) -> let bp' = bp { llvmBlockShape = sh } in implSimplM Proxy (SImpl_IntroLLVMBlockFromEq x bp' y) + +-- For [l]ptrsh(rw,sh), eliminate to a pointer to a memblock with shape sh implElimLLVMBlock x bp@(LLVMBlockPerm { llvmBlockShape = PExpr_PtrShape maybe_rw maybe_l sh }) | Just len <- llvmShapeLength sh = let bp' = bp { llvmBlockLen = len, llvmBlockShape = sh } in implSimplM Proxy (SImpl_ElimLLVMBlockPtr x maybe_rw maybe_l bp') + +-- For a field shape, eliminate to a field permission implElimLLVMBlock x (LLVMBlockPerm { llvmBlockShape = PExpr_FieldShape (LLVMFieldShape p) , ..}) = @@ -3975,25 +3986,47 @@ implElimLLVMBlock x (LLVMBlockPerm { llvmBlockShape = llvmFieldOffset = llvmBlockOffset, llvmFieldContents = p }) llvmBlockLen) + +-- For an array shape, eliminate to an array permission implElimLLVMBlock x bp@(LLVMBlockPerm { llvmBlockShape = PExpr_ArrayShape _ _ _ }) = implSimplM Proxy (SImpl_ElimLLVMBlockArray x $ llvmArrayBlockToArrayPerm bp) + +-- Special case: for shape sh1;emptysh where the natural length of sh1 is the +-- same as the length of the block permission, eliminate the emptysh, converting +-- to a memblock permission of shape sh1 +implElimLLVMBlock x bp@(LLVMBlockPerm { llvmBlockShape = + PExpr_SeqShape sh PExpr_EmptyShape }) + | Just len <- llvmShapeLength sh + , bvEq len (llvmBlockLen bp) = + implSimplM Proxy (SImpl_ElimLLVMBlockSeqEmpty x + (bp { llvmBlockShape = sh })) + +-- Otherwise, for a sequence shape sh1;sh2, eliminate to two memblock +-- permissions, of shapes sh1 and sh2 implElimLLVMBlock x bp@(LLVMBlockPerm { llvmBlockShape = PExpr_SeqShape sh1 sh2 }) | isJust $ llvmShapeLength sh1 = implSimplM Proxy (SImpl_ElimLLVMBlockSeq x (bp { llvmBlockShape = sh1 }) sh2) + +-- For an or shape, eliminate to a disjunctive permisison implElimLLVMBlock x bp@(LLVMBlockPerm { llvmBlockShape = PExpr_OrShape sh1 sh2 }) = implSimplM Proxy (SImpl_ElimLLVMBlockOr x (bp { llvmBlockShape = sh1 }) sh2) + +-- For an existential shape, eliminate to an existential permisison implElimLLVMBlock x bp@(LLVMBlockPerm { llvmBlockShape = PExpr_ExShape _mb_sh }) = implSimplM Proxy (SImpl_ElimLLVMBlockEx x bp) + +-- If none of the above cases matched, we cannot eliminate, so fail implElimLLVMBlock _ bp = implTraceM (\i -> pretty "Could not eliminate permission" <+> permPretty i (Perm_LLVMBlock bp)) >>>= implFailM + -- | Assume the top of the stack contains @x:ps@, which are all the permissions -- for @x@. Extract the @i@th conjuct from @ps@, which should be a @memblock@ -- permission, pop the remaining permissions back to @x@, eliminate the @@ -5385,6 +5418,26 @@ proveVarLLVMBlocks' x ps psubst mb_bps_in mb_ps = case mbMatch mb_bps_in of proveVarLLVMBlocks x ps' psubst mb_bps_in mb_ps + -- If the offset and length of the top block matches one that we already have + -- on the left, but the left-hand permission has an unneeded empty shape at + -- the end, i.e., is of the form sh;emptysh where the natural length of sh is + -- the length of the left-hand permission, remove that trailing empty shape + [nuMP| mb_bp : _ |] + | Just off <- partialSubst psubst $ fmap llvmBlockOffset mb_bp + , Just len <- partialSubst psubst $ fmap llvmBlockLen mb_bp + , Just i <- findIndex + (\case + Perm_LLVMBlock bp + | PExpr_SeqShape sh1 PExpr_EmptyShape <- llvmBlockShape bp + , Just len' <- llvmShapeLength sh1 -> + bvEq (llvmBlockOffset bp) off && + bvEq (llvmBlockLen bp) len && + bvEq len len' + _ -> False) ps -> + implElimAppendIthLLVMBlock x ps i >>>= \ps' -> + proveVarLLVMBlocks x ps' psubst mb_bps_in mb_ps + + -- If there is a left-hand permission whose range overlaps with but is not -- contained in that of mb_bp, eliminate it. Note that we exclude mb_bp with 0 -- length for this case. @@ -5493,6 +5546,8 @@ proveVarLLVMBlocks' x ps psubst mb_bps_in mb_ps = case mbMatch mb_bps_in of , [nuMP| Just mb_sh' |] <- mbMatch $ (mbMap3 unfoldModalizeNamedShape rw l nmsh `mbApply` args) -> -- Recurse using the unfolded shape + (if mbLift (fmap namedShapeIsRecursive nmsh) then implSetRecRecurseRightM + else return ()) >>> let mb_bps' = mbMap3 (\bp sh' bps -> (bp { llvmBlockShape = sh' } : bps)) mb_bp mb_sh' mb_bps in From da20fb77c329b2da46bc063b11373c091f00bfa9 Mon Sep 17 00:00:00 2001 From: Eddy Westbrook Date: Thu, 5 Aug 2021 17:38:46 -0700 Subject: [PATCH 12/28] finished updating Implication.hs with the new lowned permission form --- .../src/Verifier/SAW/Heapster/Implication.hs | 115 ++++++++++++------ .../src/Verifier/SAW/Heapster/Permissions.hs | 8 ++ 2 files changed, 85 insertions(+), 38 deletions(-) diff --git a/heapster-saw/src/Verifier/SAW/Heapster/Implication.hs b/heapster-saw/src/Verifier/SAW/Heapster/Implication.hs index 88a6d34daa..eacc88ce6a 100644 --- a/heapster-saw/src/Verifier/SAW/Heapster/Implication.hs +++ b/heapster-saw/src/Verifier/SAW/Heapster/Implication.hs @@ -807,7 +807,7 @@ data SimplImpl ps_in ps_out where SImpl_RemoveContainedLifetime :: ExprVar LifetimeType -> [PermExpr LifetimeType] -> LOwnedPerms ps_in -> LOwnedPerms ps_out -> - PermExpr LifetimeType -> + ExprVar LifetimeType -> SimplImpl (RNil :> LifetimeType :> LifetimeType) (RNil :> LifetimeType) @@ -1705,7 +1705,7 @@ simplImplIn (SImpl_ContainedLifetimeCurrent l ls ps_in ps_out l2) = error ("simplImplIn: SImpl_ContainedLifetimeCurrent: " ++ "lifetime not in contained lifetimes") simplImplIn (SImpl_RemoveContainedLifetime l ls ps_in ps_out l2) = - if elem l2 ls then + if elem (PExpr_Var l2) ls then distPerms2 l (ValPerm_LOwned ls ps_in ps_out) l2 ValPerm_LFinished else error ("simplImplIn: SImpl_RemoveContainedLifetime: " ++ @@ -2029,8 +2029,8 @@ simplImplOut (SImpl_ContainedLifetimeCurrent l ls ps_in ps_out l2) = error ("simplImplOut: SImpl_ContainedLifetimeCurrent: " ++ "lifetime not in contained lifetimes") simplImplOut (SImpl_RemoveContainedLifetime l ls ps_in ps_out l2) = - if elem l2 ls then - distPerms1 l (ValPerm_LOwned (delete l2 ls) ps_in ps_out) + if elem (PExpr_Var l2) ls then + distPerms1 l (ValPerm_LOwned (delete (PExpr_Var l2) ls) ps_in ps_out) else error ("simplImplOut: SImpl_RemoveContainedLifetime: " ++ "lifetime not in contained lifetimes") @@ -3693,15 +3693,19 @@ implBeginLifetimeM = -- | End a lifetime, assuming the top of the stack is of the form -- --- > ps, ps_in, l:lowned(ps_in -o ps_out) +-- > ps_in, l:lowned(ps_in -o ps_out) -- --- Pop all the returned permissions @ps_out@, leaving just @ps@ on the stack. +-- Recombine all the returned permissions @ps_out@ and @l:lfinished@, leaving +-- just @ps@ on the stack. implEndLifetimeM :: NuMatchingAny1 r => Proxy ps -> ExprVar LifetimeType -> LOwnedPerms ps_in -> LOwnedPerms ps_out -> ImplM vars s r ps (ps :++: ps_in :> LifetimeType) () -implEndLifetimeM ps l ps_in ps_out@(lownedPermsToDistPerms -> Just dps_out) = - implSimplM ps (SImpl_EndLifetime l ps_in ps_out) >>> - recombinePermsPartial ps (DistPermsCons dps_out l ValPerm_LFinished) +implEndLifetimeM ps l ps_in ps_out@(lownedPermsToDistPerms -> Just dps_out) + | isJust (lownedPermsToDistPerms ps_in) = + implSimplM ps (SImpl_EndLifetime l ps_in ps_out) >>> + implTraceM (\i -> pretty "Lifetime" <+> + permPretty i l <+> pretty "ended") >>> + recombinePermsPartial ps (DistPermsCons dps_out l ValPerm_LFinished) implEndLifetimeM _ _ _ _ = implFailM "implEndLifetimeM: lownedPermsToDistPerms" @@ -3759,22 +3763,22 @@ implContainedLifetimeCurrentM l ls ps_in ps_out l2 = implPopM l (ValPerm_LOwned ls ps_in ps_out) --- | Remove a finshed contained lifetime from an @lowned@ permission, assuming --- the permissions +-- | Remove a finshed contained lifetime from an @lowned@ permission. Assume the +-- permissions -- -- > l1:lowned[ls1,l2,ls2] (ps_in -o ps_out) * l2:lfinished -- --- are on top of the stack and replacing them with --- --- > l1:lowned[ls1,ls2] (ps_in -o ps_out) +-- are on top of the stack, and remove @l2@ from the contained lifetimes of +-- @l1@, popping the resulting @lowned@ permission on @l1@ off of the stack. implRemoveContainedLifetimeM :: NuMatchingAny1 r => ExprVar LifetimeType -> [PermExpr LifetimeType] -> LOwnedPerms ps_in -> LOwnedPerms ps_out -> - PermExpr LifetimeType -> - ImplM vars s r (ps :> LifetimeType) + ExprVar LifetimeType -> + ImplM vars s r ps (ps :> LifetimeType :> LifetimeType) () implRemoveContainedLifetimeM l ls ps_in ps_out l2 = - implSimplM Proxy (SImpl_RemoveContainedLifetime l ls ps_in ps_out l2) + implSimplM Proxy (SImpl_RemoveContainedLifetime l ls ps_in ps_out l2) >>> + implPopM l (ValPerm_LOwned (delete (PExpr_Var l2) ls) ps_in ps_out) -- | Find all lifetimes that we currently own which could, if ended, help prove @@ -6203,8 +6207,16 @@ proveVarAtomicImpl x ps mb_p = case mbMatch mb_p of proveEq fperms mb_fperms >>>= \eqp -> implCastPermM x (fmap (ValPerm_Conj1 . Perm_LLVMFrame) eqp) - [nuMP| Perm_LOwned mb_ls mb_ps_inR mb_ps_outR |] - | [Perm_LOwned ls ps_inL ps_outL] <- ps -> + -- FIXME HERE: eventually we should handle lowned permissions on the right + -- with arbitrary contained lifetimes, by equalizing the two sides + [nuMP| Perm_LOwned [] _ _ |] + | [Perm_LOwned (mapM asVar -> Just ls) _ _] <- ps -> + implPopM x (ValPerm_Conj ps) >>> + mapM_ implEndLifetimeRecM ls >>> + proveVarImplInt x (fmap ValPerm_Conj1 mb_p) + + [nuMP| Perm_LOwned [] mb_ps_inR mb_ps_outR |] + | [Perm_LOwned [] ps_inL ps_outL] <- ps -> -- First, simplify both sides using any current equality permissions. This -- just builds the equality proofs and computes the new LHS and RHS, but @@ -6247,7 +6259,7 @@ proveVarAtomicImpl x ps mb_p = case mbMatch mb_p of getPSubst >>>= \psubst -> let eqp_R = fmap (\(mb_ps_in,mb_ps_out) -> - ValPerm_LOwned ls + ValPerm_LOwned [] (partialSubstForce psubst mb_ps_in "proveVarAtomicImpl") (partialSubstForce psubst mb_ps_out "proveVarAtomicImpl")) eqp_mb_psR in @@ -6266,8 +6278,8 @@ proveVarAtomicImpl x ps mb_p = case mbMatch mb_p of -- lowned permissions and casting it, and then cast the result implPushM x (ValPerm_Conj ps) >>> implCastPermM x (fmap (\(ps_in,ps_out) -> - ValPerm_LOwned ls ps_in ps_out) eqp_psL) >>> - implSimplM Proxy (SImpl_MapLifetime x ls ps_inL' ps_outL' ps_inR' ps_outR' + ValPerm_LOwned [] ps_in ps_out) eqp_psL) >>> + implSimplM Proxy (SImpl_MapLifetime x [] ps_inL' ps_outL' ps_inR' ps_outR' ps1 ps2 impl_in impl_out) >>> implCastPermM x (someEqProofSym eqp_R) @@ -6283,11 +6295,16 @@ proveVarAtomicImpl x ps mb_p = case mbMatch mb_p of implSimplM Proxy (SImpl_LCurrentTrans x l l') [Perm_LOwned ls ps_in ps_out] | elem l' ls -> implContainedLifetimeCurrentM x ls ps_in ps_out l' - [Perm_LOwned sub_ls ps_in ps_out] -> + [Perm_LOwned ls ps_in ps_out] -> implSubsumeLifetimeM x ls ps_in ps_out l' >>> implContainedLifetimeCurrentM x (l':ls) ps_in ps_out l' _ -> proveVarAtomicImplUnfoldOrFail x ps mb_p + [nuMP| Perm_LFinished |] -> + implPopM x (ValPerm_Conj ps) >>> implEndLifetimeRecM x >>> + implPushM x ValPerm_LFinished >>> implCopyM x ValPerm_LFinished >>> + implPopM x ValPerm_LFinished + -- If we have a struct permission on the left, eliminate it to a sequence of -- variables and prove the required permissions for each variable [nuMP| Perm_Struct mb_str_ps |] @@ -6916,6 +6933,36 @@ localProveVars ps_in ps_out = -- * External Entrypoints to the Implication Prover ---------------------------------------------------------------------- +-- | End a lifetime and, recursively, all lifetimes it contains, assuming that +-- @lowned@ permissions are held for all of those lifetimes. For each lifetime +-- that is ended, prove its required input permissions and recombine the +-- resulting output permissions. If a lifetime has already ended, do nothing. +implEndLifetimeRecM :: NuMatchingAny1 r => ExprVar LifetimeType -> + ImplM vars s r ps ps () +implEndLifetimeRecM l = + getPerm l >>>= \case + ValPerm_LFinished -> return () + p@(ValPerm_LOwned [] ps_in ps_out) + | Just dps_in <- lownedPermsToDistPerms ps_in -> + mbVarsM dps_in >>>= \mb_dps_in -> + -- NOTE: we are assuming that l's permission, p, will not change during + -- this recursive call to the prover, which should be safe + proveVarsImplAppendInt mb_dps_in >>> + implPushM l p >>> + implEndLifetimeM Proxy l ps_in ps_out + p@(ValPerm_LOwned ((asVar -> Just l') : ls) ps_in ps_out) -> + implPushM l p >>> + implEndLifetimeRecM l' >>> + implPushM l' ValPerm_LFinished >>> implCopyM l' ValPerm_LFinished >>> + implPopM l' ValPerm_LFinished >>> + implRemoveContainedLifetimeM l ls ps_in ps_out l' >>> + implEndLifetimeRecM l + _ -> + implTraceM (\i -> + pretty "implEndLifetimeRecM: could not end lifetime: " <> + permPretty i l) >>>= implFailM + + -- | Prove a list of existentially-quantified distinguished permissions, adding -- those proofs to the top of the stack. In the case that a the variable itself -- whose permissions are being proved is existentially-quantified --- that is, @@ -6926,26 +6973,18 @@ proveVarsImplAppend :: NuMatchingAny1 r => ExDistPerms vars ps -> ImplM vars s r (ps_in :++: ps) ps_in () proveVarsImplAppend mb_ps = use implStatePerms >>>= \(_ :: PermSet ps_in) -> - let prx :: Proxy ps_in = Proxy in lifetimesThatCouldProve mb_ps >>>= \ls_ps -> foldr1 implCatchM ((proveVarsImplAppendInt mb_ps) : flip map ls_ps - (\case - (l,l_p@(Perm_LOwned ps_in@(lownedPermsToDistPerms -> - Just dps_in) ps_out)) -> - implTraceM (\i -> - sep [pretty "Ending lifetime" <+> permPretty i l, - pretty "in order to prove:", - permPretty i mb_ps]) >>> - proveVarsImplAppendInt (fmap (const dps_in) mb_ps) >>> - implPushM l (ValPerm_Conj1 l_p) >>> - implEndLifetimeM prx l ps_in ps_out >>> - implTraceM (\i -> pretty "Lifetime" <+> permPretty i l - <+> pretty "ended") >>> - proveVarsImplAppend mb_ps - _ -> error "proveVarsImplAppend: unexpected lifetimesThatCouldProve result")) + (\(l,_) -> + implTraceM (\i -> + sep [pretty "Ending lifetime" <+> permPretty i l, + pretty "in order to prove:", + permPretty i mb_ps]) >>> + implEndLifetimeRecM l >>> + proveVarsImplAppend mb_ps)) -- | Prove a list of existentially-quantified distinguished permissions and put -- those proofs onto the stack. This is the same as 'proveVarsImplAppend' except diff --git a/heapster-saw/src/Verifier/SAW/Heapster/Permissions.hs b/heapster-saw/src/Verifier/SAW/Heapster/Permissions.hs index 031c16d325..0d7c5bc653 100644 --- a/heapster-saw/src/Verifier/SAW/Heapster/Permissions.hs +++ b/heapster-saw/src/Verifier/SAW/Heapster/Permissions.hs @@ -2046,6 +2046,14 @@ asVarOffset (PExpr_Var x) = Just (x, NoPermOffset) asVarOffset (PExpr_LLVMOffset x off) = Just (x, LLVMPermOffset off) asVarOffset _ = Nothing +-- | Convert an expression to a variable if possible +asVar :: PermExpr a -> Maybe (ExprVar a) +asVar e + | Just (x,off) <- asVarOffset e + , offsetsEq off NoPermOffset = + Just x +asVar _ = Nothing + -- | Negate a 'PermOffset' negatePermOffset :: PermOffset a -> PermOffset a negatePermOffset NoPermOffset = NoPermOffset From ea196ef3424526f35990a7803481f5aec0d5d188 Mon Sep 17 00:00:00 2001 From: Eddy Westbrook Date: Fri, 6 Aug 2021 09:04:13 -0700 Subject: [PATCH 13/28] reorganized proveVarLLVMBlocks into two separate stages represented by two separate functions, all of which now take lists of multi-bindings instead of multi-bindings of lists --- .../src/Verifier/SAW/Heapster/Implication.hs | 1320 +++++++++-------- 1 file changed, 671 insertions(+), 649 deletions(-) diff --git a/heapster-saw/src/Verifier/SAW/Heapster/Implication.hs b/heapster-saw/src/Verifier/SAW/Heapster/Implication.hs index 7b849795f6..337b754487 100644 --- a/heapster-saw/src/Verifier/SAW/Heapster/Implication.hs +++ b/heapster-saw/src/Verifier/SAW/Heapster/Implication.hs @@ -2703,6 +2703,17 @@ mbVarsM a = do px <- uses implStateVars cruCtxProxies pure (mbPure px a) +-- | Build a multi-binding for the current existential variables using a +-- function that expects a substitution of these new variables for old copies of +-- those variables +mbSubstM :: ((forall a. Substable PermVarSubst a Identity => + Mb vars a -> a) -> b) -> + ImplM vars s r ps ps (Mb vars b) +mbSubstM f = + do vars <- uses implStateVars cruCtxProxies + return (nuMulti vars $ \ns -> + f (varSubst $ permVarSubstOfNames ns)) + -- | Apply the current partial substitution to an expression, failing if the -- partial substitution is not complete enough. The supplied 'String' is the -- calling function, used for error reporting in the failure. @@ -4038,8 +4049,7 @@ implElimPopIthLLVMBlock :: (1 <= w, KnownNat w, NuMatchingAny1 r) => [AtomicPerm (LLVMPointerType w)] -> Int -> ImplM vars s r ps (ps :> LLVMPointerType w) () implElimPopIthLLVMBlock x ps i - | i < length ps - , Perm_LLVMBlock bp <- ps!!i = + | Perm_LLVMBlock bp <- ps!!i = implExtractConjM x ps i >>> implPopM x (ValPerm_Conj $ deleteNth i ps) >>> implElimLLVMBlock x bp >>> getTopDistPerm x >>>= \p' -> recombinePerm x p' implElimPopIthLLVMBlock _ _ _ = error "implElimPopIthLLVMBlock: malformed inputs" @@ -4063,7 +4073,7 @@ implElimAppendIthLLVMBlock :: (1 <= w, KnownNat w, NuMatchingAny1 r) => (ps :> LLVMPointerType w) [AtomicPerm (LLVMPointerType w)] implElimAppendIthLLVMBlock x ps i - | i < length ps , Perm_LLVMBlock bp <- ps!!i = + | Perm_LLVMBlock bp <- ps!!i = implExtractSwapConjM x ps i >>> implElimLLVMBlock x bp >>> elimOrsExistsM x >>>= \case (ValPerm_Conj ps') -> @@ -5269,25 +5279,45 @@ proveVarLLVMBlock :: ImplM vars s r (ps :> LLVMPointerType w) (ps :> LLVMPointerType w) () proveVarLLVMBlock x ps mb_bp = do psubst <- getPSubst - proveVarLLVMBlocks x ps psubst (fmap (: []) mb_bp) (fmap (const []) mb_bp) + proveVarLLVMBlocks x ps psubst [mb_bp] [] -- | Prove a conjunction of block and atomic permissions for @x@, assuming all -- of the permissions for @x@ are on the top of the stack and given by the -- second argument. The block permissions are the ones that we are currently -- working on, and when they are all proved we bottom out to 'proveVarConjImpl'. +-- +-- A central motivation of this algorithm is to do as little elimination on the +-- left or introduction on the right as possible, in order to build the smallest +-- derivation we can. The algorithm iterates through the block permissions on +-- the right, trying for each of them to either match it up with a block +-- permission on the left or simplify it to a non-block permission. The first +-- stage of the algorithm attempts to break down permissions on the left that +-- overlap with but are not contained in the current block permission on the +-- right we are trying to prove, so that we end up with permissions on the left +-- that are no bigger than the right. This stage is performed by +-- 'proveVarLLVMBlocks1'. The algorithm then repeatedly breaks down the +-- right-hand block permission we are trying to prove, going back to stage one +-- if necessary if this leads to it being smaller than some left-hand +-- permission, until we either get a precise match or we eventually break the +-- right-hand permission down to a non-block permission. This stage is performed +-- by 'proveVarLLVMBlocks2'. proveVarLLVMBlocks :: (1 <= w, KnownNat w, NuMatchingAny1 r) => ExprVar (LLVMPointerType w) -> [AtomicPerm (LLVMPointerType w)] -> PartialSubst vars -> - Mb vars [LLVMBlockPerm w] -> Mb vars [AtomicPerm (LLVMPointerType w)] -> + [Mb vars (LLVMBlockPerm w)] -> [Mb vars (AtomicPerm (LLVMPointerType w))] -> ImplM vars s r (ps :> LLVMPointerType w) (ps :> LLVMPointerType w) () proveVarLLVMBlocks x ps psubst mb_bps mb_ps = + -- This substitution is to only print the existential vars once, on the + -- outside; also, substituting here ensures that we only traverse the + -- permissions once + mbSubstM (\s -> (map s mb_bps, map s mb_ps)) >>>= \mb_bps_ps -> implTraceM (\i -> sep [pretty "proveVarLLVMBlocks", permPretty i x <> colon <> permPretty i ps, - pretty "-o", permPretty i mb_bps, permPretty i mb_ps]) >>> - proveVarLLVMBlocks' x ps psubst mb_bps mb_ps + pretty "-o", permPretty i mb_bps_ps]) >>> + proveVarLLVMBlocks1 x ps psubst mb_bps mb_ps -- | Call 'proveVarLLVMBlock' in a context extended with a fresh existential @@ -5297,12 +5327,12 @@ proveVarLLVMBlocksExt1 :: (1 <= w, KnownNat w, KnownRepr TypeRepr tp, NuMatchingAny1 r) => ExprVar (LLVMPointerType w) -> [AtomicPerm (LLVMPointerType w)] -> PartialSubst vars -> Mb (vars :> tp) (LLVMBlockPerm w) -> - Mb vars [LLVMBlockPerm w] -> Mb vars [AtomicPerm (LLVMPointerType w)] -> + [Mb vars (LLVMBlockPerm w)] -> [Mb vars (AtomicPerm (LLVMPointerType w))] -> ImplM vars s r (ps :> LLVMPointerType w) (ps :> LLVMPointerType w) (PermExpr tp) proveVarLLVMBlocksExt1 x ps psubst mb_bp_ext mb_bps mb_ps = fmap snd $ withExtVarsM $ - proveVarLLVMBlocks x ps (extPSubst psubst) (mbMap2 (:) mb_bp_ext $ - extMb mb_bps) (extMb mb_ps) + proveVarLLVMBlocks x ps (extPSubst psubst) + (mb_bp_ext : map extMb mb_bps) (map extMb mb_ps) -- | Like 'proveVarLLVMBlockExt1' but bind 2 existential variables, which can be -- used in 0 or more block permissions we want to prove @@ -5311,663 +5341,655 @@ proveVarLLVMBlocksExt2 :: KnownRepr TypeRepr tp2, NuMatchingAny1 r) => ExprVar (LLVMPointerType w) -> [AtomicPerm (LLVMPointerType w)] -> PartialSubst vars -> Mb (vars :> tp1 :> tp2) [LLVMBlockPerm w] -> - Mb vars [LLVMBlockPerm w] -> Mb vars [AtomicPerm (LLVMPointerType w)] -> + [Mb vars (LLVMBlockPerm w)] -> [Mb vars (AtomicPerm (LLVMPointerType w))] -> ImplM vars s r (ps :> LLVMPointerType w) (ps :> LLVMPointerType w) (PermExpr tp1, PermExpr tp2) proveVarLLVMBlocksExt2 x ps psubst mb_bps_ext mb_bps mb_ps = withExtVarsM (withExtVarsM $ proveVarLLVMBlocks x ps (extPSubst $ extPSubst psubst) - (mbMap2 (++) mb_bps_ext (extMb $ extMb mb_bps)) - (extMb $ extMb mb_ps)) >>= \((_,e2),e1) -> + (mbList mb_bps_ext ++ (map (extMb . extMb) mb_bps)) + (map (extMb . extMb) mb_ps)) >>= \((_,e2),e1) -> pure (e1,e2) --- | The "real" version of 'proveVarLLVMBlocks'. That function is just a debug --- printing wrapper around this one. --- --- A central motivation of this algorithm is to do as little elimination on the --- left or introduction on the right as possible, in order to build the smallest --- derivation we can. The algorithm iterates through the block permissions on --- the right, trying for each of them to either match it up with a block --- permission on the left or simplify it to a non-block permission. The first --- stage of the algorithm attempts to break down permissions on the left that --- overlap with but are not contained in the current block permission on the --- right we are trying to prove, so that we end up with permissions on the left --- that are no bigger than the right. It then repeatedly breaks down the --- right-hand block permission we are trying to prove, going back to stage one --- if necessary if this leads to it being smaller than some left-hand --- permission, until we either get a precise match or we eventually break the --- right-hand permission down to a non-block permission. -proveVarLLVMBlocks' :: +-- | Stage 1 of 'proveVarLLVMBlocks'. See that comments on that function. +proveVarLLVMBlocks1 :: (1 <= w, KnownNat w, NuMatchingAny1 r) => ExprVar (LLVMPointerType w) -> [AtomicPerm (LLVMPointerType w)] -> PartialSubst vars -> - Mb vars [LLVMBlockPerm w] -> Mb vars [AtomicPerm (LLVMPointerType w)] -> + [Mb vars (LLVMBlockPerm w)] -> [Mb vars (AtomicPerm (LLVMPointerType w))] -> ImplM vars s r (ps :> LLVMPointerType w) (ps :> LLVMPointerType w) () -proveVarLLVMBlocks' x ps psubst mb_bps_in mb_ps = case mbMatch mb_bps_in of - -- If we are done with blocks, call proveVarConjImpl - [nuMP| [] |] -> - proveVarConjImpl x ps mb_ps +-- If we are done with blocks, call proveVarConjImpl +proveVarLLVMBlocks1 x ps _ [] mb_ps = + mbSubstM (\s -> map s mb_ps) >>>= proveVarConjImpl x ps + +-- If the offset, length, and shape of the top block matches one that we already +-- have, just cast the rwmodality and lifetime and prove the remaining perms +proveVarLLVMBlocks1 x ps psubst (mb_bp:mb_bps) mb_ps + | Just off <- partialSubst psubst $ fmap llvmBlockOffset mb_bp + , Just len <- partialSubst psubst $ fmap llvmBlockLen mb_bp + , Just i <- findIndex (\case + Perm_LLVMBlock bp -> + bvEq (llvmBlockOffset bp) off && + bvEq (llvmBlockLen bp) len && + mbLift (fmap ((== llvmBlockShape bp) + . llvmBlockShape) mb_bp) + _ -> False) ps + , Perm_LLVMBlock bp <- ps!!i = - -- If the offset, length, and shape of the top block matches one that we already - -- have, just cast the rwmodality and lifetime and prove the remaining perms - [nuMP| mb_bp : mb_bps |] - | Just off <- partialSubst psubst $ fmap llvmBlockOffset mb_bp - , Just len <- partialSubst psubst $ fmap llvmBlockLen mb_bp - , Just i <- findIndex (\case - Perm_LLVMBlock bp -> - bvEq (llvmBlockOffset bp) off && - bvEq (llvmBlockLen bp) len && - mbLift (fmap ((== llvmBlockShape bp) - . llvmBlockShape) mb_bp) - _ -> False) ps - , Perm_LLVMBlock bp <- ps!!i -> - - -- Copy or extract the memblock perm we chose to the top of the stack - (if atomicPermIsCopyable (ps!!i) then - implCopySwapConjM x ps i >>> pure ps - else - implExtractSwapConjM x ps i >>> pure (deleteNth i ps)) >>>= \ps' -> - - -- Cast it to have the correct RW modality - (case (llvmBlockRW bp, fmap llvmBlockRW mb_bp) of - -- If the modalities are already equal, do nothing - (rw, mb_rw) | mbLift (fmap (== rw) mb_rw) -> pure () - (_, mbMatch -> [nuMP| PExpr_Read |]) -> - implSimplM Proxy (SImpl_DemoteLLVMBlockRW x bp) - _ -> - proveEqCast x (\rw -> ValPerm_LLVMBlock $ bp { llvmBlockRW = rw }) - (llvmBlockRW bp) (fmap llvmBlockRW mb_bp)) >>> - getTopDistPerm x >>>= \(ValPerm_LLVMBlock bp') -> - - -- Get the lifetime correct - let (f, args) = blockToLTFunc bp' in - proveVarLifetimeFunctor x f args (llvmBlockLifetime bp) (fmap - llvmBlockLifetime - mb_bp) >>> - getTopDistPerm x >>>= \(ValPerm_LLVMBlock bp'') -> - - -- Move it down below ps' - implSwapM x (ValPerm_Conj ps') x (ValPerm_LLVMBlock bp'') >>> - - -- Recursively prove the remaining perms - proveVarLLVMBlocks x ps' psubst mb_bps mb_ps >>> - getTopDistPerm x >>>= \(ValPerm_Conj ps_out) -> - - -- Finally, combine the one memblock perm we chose with the rest of them - implInsertConjM x (Perm_LLVMBlock bp'') ps_out 0 - - - -- If the offset and length of the top block matches one that we already have - -- on the left, but the left-hand permission has a defined shape, unfold the - -- defined shape - [nuMP| mb_bp : _ |] - | Just off <- partialSubst psubst $ fmap llvmBlockOffset mb_bp - , Just len <- partialSubst psubst $ fmap llvmBlockLen mb_bp - , Just i <- findIndex - (\case - Perm_LLVMBlock bp - | PExpr_NamedShape _ _ nmsh _ <- llvmBlockShape bp - , DefinedShapeBody _ <- namedShapeBody nmsh -> - bvEq (llvmBlockOffset bp) off && - bvEq (llvmBlockLen bp) len - _ -> False) ps -> - implElimAppendIthLLVMBlock x ps i >>>= \ps' -> - proveVarLLVMBlocks x ps' psubst mb_bps_in mb_ps - - - -- If the offset and length of the top block matches one that we already have - -- on the left, but the left-hand permission has an unneeded empty shape at - -- the end, i.e., is of the form sh;emptysh where the natural length of sh is - -- the length of the left-hand permission, remove that trailing empty shape - [nuMP| mb_bp : _ |] - | Just off <- partialSubst psubst $ fmap llvmBlockOffset mb_bp - , Just len <- partialSubst psubst $ fmap llvmBlockLen mb_bp - , Just i <- findIndex - (\case - Perm_LLVMBlock bp - | PExpr_SeqShape sh1 PExpr_EmptyShape <- llvmBlockShape bp - , Just len' <- llvmShapeLength sh1 -> + -- Copy or extract the memblock perm we chose to the top of the stack + (if atomicPermIsCopyable (ps!!i) then + implCopySwapConjM x ps i >>> pure ps + else + implExtractSwapConjM x ps i >>> pure (deleteNth i ps)) >>>= \ps' -> + + -- Cast it to have the correct RW modality + (case (llvmBlockRW bp, fmap llvmBlockRW mb_bp) of + -- If the modalities are already equal, do nothing + (rw, mb_rw) | mbLift (fmap (== rw) mb_rw) -> pure () + (_, mbMatch -> [nuMP| PExpr_Read |]) -> + implSimplM Proxy (SImpl_DemoteLLVMBlockRW x bp) + _ -> + proveEqCast x (\rw -> ValPerm_LLVMBlock $ bp { llvmBlockRW = rw }) + (llvmBlockRW bp) (fmap llvmBlockRW mb_bp)) >>> + getTopDistPerm x >>>= \(ValPerm_LLVMBlock bp') -> + + -- Get the lifetime correct + let (f, args) = blockToLTFunc bp' in + proveVarLifetimeFunctor x f args (llvmBlockLifetime bp) (fmap + llvmBlockLifetime + mb_bp) >>> + getTopDistPerm x >>>= \(ValPerm_LLVMBlock bp'') -> + + -- Move it down below ps' + implSwapM x (ValPerm_Conj ps') x (ValPerm_LLVMBlock bp'') >>> + + -- Recursively prove the remaining perms + proveVarLLVMBlocks x ps' psubst mb_bps mb_ps >>> + getTopDistPerm x >>>= \(ValPerm_Conj ps_out) -> + + -- Finally, combine the one memblock perm we chose with the rest of them + implInsertConjM x (Perm_LLVMBlock bp'') ps_out 0 + + +-- If the offset and length of the top block matches one that we already have on +-- the left, but the left-hand permission has a defined shape, unfold the +-- defined shape +proveVarLLVMBlocks1 x ps psubst mb_bps_in@(mb_bp:_) mb_ps + | Just off <- partialSubst psubst $ fmap llvmBlockOffset mb_bp + , Just len <- partialSubst psubst $ fmap llvmBlockLen mb_bp + , Just i <- findIndex + (\case + Perm_LLVMBlock bp + | PExpr_NamedShape _ _ nmsh _ <- llvmBlockShape bp + , DefinedShapeBody _ <- namedShapeBody nmsh -> bvEq (llvmBlockOffset bp) off && - bvEq (llvmBlockLen bp) len && - bvEq len len' - _ -> False) ps -> - implElimAppendIthLLVMBlock x ps i >>>= \ps' -> - proveVarLLVMBlocks x ps' psubst mb_bps_in mb_ps - - - -- If there is a left-hand permission whose range overlaps with but is not - -- contained in that of mb_bp, eliminate it. Note that we exclude mb_bp with 0 - -- length for this case. - [nuMP| mb_bp : _ |] - | Just off <- partialSubst psubst $ fmap llvmBlockOffset mb_bp - , Just len <- partialSubst psubst $ fmap llvmBlockLen mb_bp - , not (bvIsZero len) - , rng <- BVRange off len - , Just i <- findIndex (\case - Perm_LLVMBlock bp -> - bvRangesCouldOverlap (llvmBlockRange bp) rng && - not (bvRangeSubset (llvmBlockRange bp) rng) - _ -> False) ps -> - implElimAppendIthLLVMBlock x ps i >>>= \ps' -> - proveVarLLVMBlocks x ps' psubst mb_bps_in mb_ps - - - -- If proving the empty shape for length 0, recursively prove everything else - -- and then use the empty introduction rule - [nuMP| mb_bp : mb_bps |] - | [nuMP| PExpr_EmptyShape |] <- mbMatch $ fmap llvmBlockShape mb_bp - , Just len <- partialSubst psubst $ fmap llvmBlockLen mb_bp - , bvIsZero len -> - - -- Do the recursive call without the empty shape and remember what - -- permissions it proved - proveVarLLVMBlocks x ps psubst mb_bps mb_ps >>> - getTopDistPerm x >>>= \(ValPerm_Conj ps_out) -> - - -- Substitute into the required block perm and prove it with - -- SImpl_IntroLLVMBlockEmpty - -- - -- FIXME: if the rwmodality or lifetime are still unset at this point, we - -- could set them to default values, but this will be a rare case - partialSubstForceM mb_bp "proveVarLLVMBlock" >>>= \bp -> - implSimplM Proxy (SImpl_IntroLLVMBlockEmpty x bp) >>> - - -- Finally, recombine the resulting permission with the rest of them - implSwapInsertConjM x (Perm_LLVMBlock bp) ps_out 0 - - - -- If proving the empty shape otherwise, prove an arbitrary memblock permission, - -- i.e., with shape y for evar y, and coerce it to the empty shape - [nuMP| mb_bp : mb_bps |] - | [nuMP| PExpr_EmptyShape |] <- mbMatch $ fmap llvmBlockShape mb_bp -> - - -- Locally bind z_sh for the shape of the memblock perm and recurse - let mb_bp' = - mbCombine RL.typeCtxProxies $ flip fmap mb_bp $ \bp -> - nu $ \z_sh -> bp { llvmBlockShape = PExpr_Var z_sh } in - proveVarLLVMBlocksExt1 x ps psubst mb_bp' mb_bps mb_ps >>> - - -- Extract out the block perm we proved and coerce it to the empty shape - getTopDistPerm x >>>= \(ValPerm_Conj ps_out) -> - let (Perm_LLVMBlock bp : ps_out') = ps_out in - implSplitSwapConjsM x ps_out 1 >>> - implSimplM Proxy (SImpl_CoerceLLVMBlockEmpty x bp) >>> - - -- Finally, recombine the resulting permission with the rest of them - implSwapInsertConjM x (Perm_LLVMBlock $ - bp { llvmBlockShape = PExpr_EmptyShape }) ps_out' 0 - - - -- If proving a memblock permission whose length is longer than the natural - -- length of its shape, prove the memblock with the natural length as well as an - -- additional memblock with empty shape and then sequence them together - [nuMP| mb_bp : mb_bps |] - | Just len <- partialSubst psubst (fmap llvmBlockLen mb_bp) - , mbLift $ fmap (\bp -> - case llvmShapeLength (llvmBlockShape bp) of - Just sh_len -> bvLt sh_len len - Nothing -> False) mb_bp -> - - -- First, build the list of the correctly-sized perm + the empty shape one - let mb_bps' = - fmap (\bp -> - let sh_len = fromJust (llvmShapeLength (llvmBlockShape bp)) in - [bp { llvmBlockLen = sh_len }, - bp { llvmBlockOffset = bvAdd (llvmBlockOffset bp) sh_len, - llvmBlockLen = bvSub (llvmBlockLen bp) sh_len, - llvmBlockShape = PExpr_EmptyShape }]) mb_bp in - - -- Next, do the recursive call - proveVarLLVMBlocks x ps psubst (mbMap2 (++) mb_bps' mb_bps) mb_ps >>> - - -- Move the correctly-sized perm + the empty shape one to the top of the - -- stack and sequence them, and then eliminate the empty shape at the end - getTopDistPerm x >>>= \(ValPerm_Conj ps') -> - let (Perm_LLVMBlock bp1 : Perm_LLVMBlock bp2 : ps'') = ps' - len2 = llvmBlockLen bp2 - bp_out = bp1 { llvmBlockLen = bvAdd (llvmBlockLen bp1) len2 } in - implSplitSwapConjsM x ps' 2 >>> - implSplitConjsM x [Perm_LLVMBlock bp1, Perm_LLVMBlock bp2] 1 >>> - implSimplM Proxy (SImpl_IntroLLVMBlockSeq x bp1 len2 PExpr_EmptyShape) >>> - implSimplM Proxy (SImpl_ElimLLVMBlockSeqEmpty x bp_out) >>> - - -- Finally, recombine the resulting permission with the rest of them - implSwapInsertConjM x (Perm_LLVMBlock bp_out) ps'' 0 - - - -- If proving an unfoldable named shape, prove its unfolding first and then - -- fold it - [nuMP| mb_bp : mb_bps |] - | [nuMP| PExpr_NamedShape rw l nmsh args |] <- mbMatch $ fmap llvmBlockShape mb_bp - , [nuMP| TrueRepr |] <- mbMatch $ fmap namedShapeCanUnfoldRepr nmsh - , [nuMP| Just mb_sh' |] <- mbMatch $ (mbMap3 unfoldModalizeNamedShape rw l nmsh - `mbApply` args) -> - -- Recurse using the unfolded shape - (if mbLift (fmap namedShapeIsRecursive nmsh) then implSetRecRecurseRightM - else return ()) >>> - let mb_bps' = - mbMap3 (\bp sh' bps -> (bp { llvmBlockShape = sh' } : bps)) - mb_bp mb_sh' mb_bps in - proveVarLLVMBlocks x ps psubst mb_bps' mb_ps >>> - - -- Extract out the block perm we proved - getTopDistPerm x >>>= \(ValPerm_Conj ps_out) -> - let (Perm_LLVMBlock bp : ps_out') = ps_out in - implSplitSwapConjsM x ps_out 1 >>> - - -- Fold the named shape - partialSubstForceM (fmap - llvmBlockShape mb_bp) "proveVarLLVMBlocks" >>>= \sh -> - let bp' = bp { llvmBlockShape = sh } in - implIntroLLVMBlockNamed x bp' >>> - - -- Finally, recombine the resulting permission with the rest of them - implSwapInsertConjM x (Perm_LLVMBlock bp') ps_out' 0 - - - -- If proving an opaque named shape, the only way to prove the memblock - -- permission is to have it on the left, but we don't have a memblock - -- permission on the left with this exact offset, length, and shape, because - -- it would have matched some previous case, so try to eliminate a memblock - -- and recurse - [nuMP| mb_bp : _ |] - | [nuMP| PExpr_NamedShape _ _ nmsh _ |] <- mbMatch $ fmap llvmBlockShape mb_bp - , [nuMP| FalseRepr |] <- mbMatch $ fmap namedShapeCanUnfoldRepr nmsh - , Just off <- partialSubst psubst $ fmap llvmBlockOffset mb_bp - , Just i <- findIndex (\case - p@(Perm_LLVMBlock _) -> - isJust (llvmPermContainsOffset off p) - _ -> False) ps - , Perm_LLVMBlock _ <- ps!!i -> - implElimAppendIthLLVMBlock x ps i >>>= \ps' -> - proveVarLLVMBlocks x ps' psubst mb_bps_in mb_ps - - - -- If proving an equality shape eqsh(z) for evar z which has already been set, - -- substitute for z and recurse - [nuMP| mb_bp : mb_bps |] - | [nuMP| PExpr_EqShape (PExpr_Var mb_z) |] <- mbMatch $ fmap llvmBlockShape mb_bp - , Left memb <- mbNameBoundP mb_z - , Just blk <- psubstLookup psubst memb -> - proveVarLLVMBlocks x ps psubst - (mbMap2 (:) (fmap (\bp -> bp { llvmBlockShape = - PExpr_EqShape blk }) mb_bp) mb_bps) - mb_ps - - - -- If proving an equality shape eqsh(z) for unset evar z, prove any memblock - -- perm with the given offset and length and eliminate it to an llvmblock with - -- an equality shape - [nuMP| mb_bp : mb_bps |] - | [nuMP| PExpr_EqShape (PExpr_Var mb_z) |] <- mbMatch $ fmap llvmBlockShape mb_bp - , Left memb <- mbNameBoundP mb_z - , Nothing <- psubstLookup psubst memb -> + bvEq (llvmBlockLen bp) len + _ -> False) ps = + implElimAppendIthLLVMBlock x ps i >>>= \ps' -> + proveVarLLVMBlocks x ps' psubst mb_bps_in mb_ps + + +-- If the offset and length of the top block matches one that we already have on +-- the left, but the left-hand permission has an unneeded empty shape at the +-- end, i.e., is of the form sh;emptysh where the natural length of sh is the +-- length of the left-hand permission, remove that trailing empty shape +proveVarLLVMBlocks1 x ps psubst mb_bps_in@(mb_bp:_) mb_ps + | Just off <- partialSubst psubst $ fmap llvmBlockOffset mb_bp + , Just len <- partialSubst psubst $ fmap llvmBlockLen mb_bp + , Just i <- findIndex + (\case + Perm_LLVMBlock bp + | PExpr_SeqShape sh1 PExpr_EmptyShape <- llvmBlockShape bp + , Just len' <- llvmShapeLength sh1 -> + bvEq (llvmBlockOffset bp) off && + bvEq (llvmBlockLen bp) len && + bvEq len len' + _ -> False) ps = + implElimAppendIthLLVMBlock x ps i >>>= \ps' -> + proveVarLLVMBlocks x ps' psubst mb_bps_in mb_ps + + +-- If there is a left-hand permission whose range overlaps with but is not +-- contained in that of mb_bp, eliminate it. Note that we exclude mb_bp with +-- length 0 for this case, since eliminating on the left does not help prove +-- these permissions. +proveVarLLVMBlocks1 x ps psubst mb_bps_in@(mb_bp:_) mb_ps + | Just off <- partialSubst psubst $ fmap llvmBlockOffset mb_bp + , Just len <- partialSubst psubst $ fmap llvmBlockLen mb_bp + , not (bvIsZero len) + , rng <- BVRange off len + , Just i <- findIndex (\case + Perm_LLVMBlock bp -> + bvRangesCouldOverlap (llvmBlockRange bp) rng && + not (bvRangeSubset (llvmBlockRange bp) rng) + _ -> False) ps = + implElimAppendIthLLVMBlock x ps i >>>= \ps' -> + proveVarLLVMBlocks x ps' psubst mb_bps_in mb_ps + + +-- If none of the above cases match for stage 1, proceed to stage 2, which +-- operates by induction on the shape +proveVarLLVMBlocks1 x ps psubst (mb_bp:mb_bps) mb_ps = + proveVarLLVMBlocks2 x ps psubst mb_bp (mbMatch $ + fmap llvmBlockShape mb_bp) mb_bps mb_ps + + +-- | Stage 2 of 'proveVarLLVMBlocks'. See that comments on that function. The +-- 5th argument is the shape of the 4th argument. +proveVarLLVMBlocks2 :: + (1 <= w, KnownNat w, NuMatchingAny1 r) => ExprVar (LLVMPointerType w) -> + [AtomicPerm (LLVMPointerType w)] -> PartialSubst vars -> + Mb vars (LLVMBlockPerm w) -> MatchedMb vars (PermExpr (LLVMShapeType w)) -> + [Mb vars (LLVMBlockPerm w)] -> [Mb vars (AtomicPerm (LLVMPointerType w))] -> + ImplM vars s r (ps :> LLVMPointerType w) (ps :> LLVMPointerType w) () - -- Locally bind z_sh for the shape of the memblock perm and recurse - let mb_bp' = - mbCombine RL.typeCtxProxies $ flip fmap mb_bp $ \bp -> - nu $ \z_sh -> bp { llvmBlockShape = PExpr_Var z_sh } in - proveVarLLVMBlocksExt1 x ps psubst mb_bp' mb_bps mb_ps >>> - - -- Extract out the block perm we proved - getTopDistPerm x >>>= \(ValPerm_Conj ps_out) -> - let (Perm_LLVMBlock bp : ps_out') = ps_out in - implSplitSwapConjsM x ps_out 1 >>> - - -- Eliminate that block perm to have an equality shape, and set z to the - -- resulting block - implElimLLVMBlockToEq x bp >>>= \y_blk -> - let bp' = bp { llvmBlockShape = PExpr_EqShape $ PExpr_Var y_blk } in - setVarM memb (PExpr_Var y_blk) >>> - - -- Finally, recombine the resulting permission with the rest of them - implSwapInsertConjM x (Perm_LLVMBlock bp') ps_out' 0 - - - -- If z is a free variable, the only way to prove the memblock permission is to - -- have it on the left, but we don't have a memblock permission on the left with - -- this exactly offset, length, and shape, because it would have matched the - -- first case above, so try to eliminate a memblock and recurse - [nuMP| mb_bp : _ |] - | [nuMP| PExpr_EqShape (PExpr_Var mb_z) |] <- mbMatch $ fmap llvmBlockShape mb_bp - , Right _ <- mbNameBoundP mb_z - , Just off <- partialSubst psubst $ fmap llvmBlockOffset mb_bp - , Just i <- findIndex (\case - p@(Perm_LLVMBlock _) -> - isJust (llvmPermContainsOffset off p) - _ -> False) ps - , Perm_LLVMBlock _ <- ps!!i -> - implElimAppendIthLLVMBlock x ps i >>>= \ps' -> - proveVarLLVMBlocks x ps' psubst mb_bps_in mb_ps - - - -- If proving a pointer shape, prove the required permission by adding it to ps; - -- this requires the pointed-to shape to have a well-defined length - [nuMP| mb_bp : mb_bps |] - | [nuMP| PExpr_PtrShape mb_rw mb_l mb_sh |] <- mbMatch $ fmap llvmBlockShape mb_bp - , mbLift $ fmap (isJust . llvmShapeLength) mb_sh -> - - -- Add a permission for a pointer to the required shape to mb_ps, and - -- recursively call proveVarLLVMBlocks to prove it and everything else - let mb_p_ptr = - mbMap4 (\bp maybe_rw maybe_l sh -> - (llvmBlockPtrAtomicPerm $ - llvmBlockAdjustModalities maybe_rw maybe_l $ - bp { llvmBlockLen = fromJust (llvmShapeLength sh), - llvmBlockShape = sh })) - mb_bp mb_rw mb_l mb_sh in - proveVarLLVMBlocks x ps psubst mb_bps (mbMap2 (:) mb_p_ptr mb_ps) >>> - - -- Move the pointer permission we proved to the top of the stack - getTopDistPerm x >>>= \(ValPerm_Conj ps') -> - let i = mbLift (fmap length mb_bps) in - implExtractSwapConjM x ps' i >>> - - -- Use the SImpl_IntroLLVMBlockPtr rule to prove the required memblock perm - partialSubstForceM mb_bp "proveVarLLVMBlocks" >>>= \bp -> - let PExpr_PtrShape maybe_rw maybe_l sh = llvmBlockShape bp in - let Just sh_len = llvmShapeLength sh in - implSimplM Proxy (SImpl_IntroLLVMBlockPtr x maybe_rw maybe_l $ - bp { llvmBlockLen = sh_len, llvmBlockShape = sh }) >>> - - -- Finally, move the memblock perm we proved back into position - implSwapInsertConjM x (Perm_LLVMBlock bp) (deleteNth i ps') 0 - - - -- If proving a field shape, prove the required permission by adding it to ps - [nuMP| mb_bp : mb_bps |] - | [nuMP| PExpr_FieldShape - (LLVMFieldShape mb_p) |] <- mbMatch $ fmap llvmBlockShape mb_bp -> - - -- Add the field permission to the required permission to mb_ps, and - -- recursively call proveVarLLVMBlocks to prove it and everything else - let mb_fp = - mbMap2 (\bp p -> - (llvmBlockPtrFieldPerm bp) { llvmFieldContents = p }) - mb_bp mb_p in - let mb_p' = fmap Perm_LLVMField mb_fp in - proveVarLLVMBlocks x ps psubst mb_bps (mbMap2 (:) mb_p' mb_ps) >>> - - -- Move the pointer permission we proved to the top of the stack - getTopDistPerm x >>>= \(ValPerm_Conj ps') -> - let i = mbLift (fmap length mb_bps) in - implExtractSwapConjM x ps' i >>> - - -- Use the SImpl_IntroLLVMBlockField rule to prove the required memblock perm - partialSubstForceM (mbMap2 (,) - mb_bp mb_fp) "proveVarLLVMBlocks" >>>= \(bp,fp) -> - implSimplM Proxy (SImpl_IntroLLVMBlockField x fp) >>> - - -- Finally, move the memblock perm we proved back into position - implSwapInsertConjM x (Perm_LLVMBlock bp) (deleteNth i ps') 0 - - - -- If proving an array shape, just like in the field case, prove the required - -- array permission and then pad it out with an empty memblock permission - [nuMP| mb_bp : mb_bps |] - | [nuMP| PExpr_ArrayShape _ _ _ |] <- mbMatch $ fmap llvmBlockShape mb_bp -> - - -- Add the array permission to the required permission to mb_ps, and - -- recursively call proveVarLLVMBlocks to prove it and everything else - let mb_ap = fmap llvmArrayBlockToArrayPerm mb_bp in - let mb_p = fmap Perm_LLVMArray mb_ap in - proveVarLLVMBlocks x ps psubst mb_bps (mbMap2 (:) mb_p mb_ps) >>> - - -- Move the pointer permission we proved to the top of the stack - getTopDistPerm x >>>= \(ValPerm_Conj ps') -> - let i = mbLift (fmap length mb_bps) in - implExtractSwapConjM x ps' i >>> - - -- Use the SImpl_IntroLLVMBlockArray rule to prove the memblock perm - partialSubstForceM (mbMap2 (,) - mb_bp mb_ap) "proveVarLLVMBlocks" >>>= \(bp,ap) -> - implSimplM Proxy (SImpl_IntroLLVMBlockArray x ap) >>> - - -- Finally, move the memblock perm we proved back into position - implSwapInsertConjM x (Perm_LLVMBlock bp) (deleteNth i ps') 0 - - - -- If proving a sequence shape, prove the two shapes and combine them; this - -- requires the first shape to have a well-defined length - [nuMP| mb_bp : mb_bps |] - | [nuMP| PExpr_SeqShape mb_sh1 _ |] <- mbMatch $ fmap llvmBlockShape mb_bp - , mbLift $ fmap (isJust . llvmShapeLength) mb_sh1 -> - - -- Add the two shapes to mb_bps and recursively call proveVarLLVMBlocks - let mb_bps12 = - fmap (\bp -> - let PExpr_SeqShape sh1 sh2 = llvmBlockShape bp in - let Just len1 = llvmShapeLength sh1 in - [bp { llvmBlockLen = len1, llvmBlockShape = sh1 }, - bp { llvmBlockOffset = bvAdd (llvmBlockOffset bp) len1, - llvmBlockLen = bvSub (llvmBlockLen bp) len1, - llvmBlockShape = sh2 }]) mb_bp in - proveVarLLVMBlocks x ps psubst (mbMap2 (++) mb_bps12 mb_bps) mb_ps >>> - - -- Move the block permissions we proved to the top of the stack - getTopDistPerm x >>>= \(ValPerm_Conj ps') -> - let (Perm_LLVMBlock bp1 : Perm_LLVMBlock bp2 : ps'') = ps' - len2 = llvmBlockLen bp2 - sh2 = llvmBlockShape bp2 in - implSplitSwapConjsM x ps' 2 >>> - - -- Use the SImpl_IntroLLVMBlockSeq rule combine them into one memblock perm - implSplitConjsM x [Perm_LLVMBlock bp1, Perm_LLVMBlock bp2] 1 >>> - implSimplM Proxy (SImpl_IntroLLVMBlockSeq x bp1 len2 sh2) >>> - - -- Finally, move the memblock perm we proved back into position - partialSubstForceM mb_bp "proveVarLLVMBlock" >>>= \bp -> - implSwapInsertConjM x (Perm_LLVMBlock bp) ps'' 0 - - - -- If proving a tagged union shape where we have an equality permission on the - -- left that matches one of the disjuncts, prove that disjunct and or it up - -- with the other disjuncts - [nuMP| mb_bp : mb_bps |] - | [nuMP| Just mb_tag_u |] <- mbMatch $ fmap (asTaggedUnionShape - . llvmBlockShape) mb_bp - , Just off <- partialSubst psubst $ fmap llvmBlockOffset mb_bp - , Just i <- mbLift $ fmap (findTaggedUnionIndexForPerms off ps) mb_tag_u - , mb_shs <- fmap taggedUnionDisjs mb_tag_u - , mb_sh <- fmap (!!i) mb_shs -> - - -- Recursively prove the ith disjunct - proveVarLLVMBlocks x ps psubst (mbMap3 - (\bp sh bps -> - bp { llvmBlockShape = sh } : bps) - mb_bp mb_sh mb_bps) mb_ps >>> - - -- Move the block permission with shape mb_sh to the top of the stack - getTopDistPerm x >>>= \(ValPerm_Conj ps') -> - implExtractSwapConjM x ps' 0 >>> - - -- Finally, weaken the block permission to be the desired tagged union - -- shape, and move it back into position - partialSubstForceM mb_shs "proveVarLLVMBlock" >>>= \shs -> - partialSubstForceM mb_bp "proveVarLLVMBlock" >>>= \bp -> - implIntroOrShapeMultiM x bp shs i >>> - implSwapInsertConjM x (Perm_LLVMBlock bp) (tail ps') 0 - - - -- If proving a disjunctive shape, try to prove one of the disjuncts - [nuMP| mb_bp : mb_bps |] - | [nuMP| PExpr_OrShape mb_sh1 mb_sh2 |] <- mbMatch $ fmap llvmBlockShape mb_bp -> - - -- Build a computation that tries returning True here, and if that fails - -- returns False; True is used for sh1 while False is used for sh2 - implCatchM (pure True) (pure False) >>>= \is_case1 -> - - -- Prove the chosen shape by recursively calling proveVarLLVMBlocks - let mb_sh = if is_case1 then mb_sh1 else mb_sh2 in - let mb_bp' = mbMap2 (\bp sh -> bp { llvmBlockShape = sh }) mb_bp mb_sh in - proveVarLLVMBlocks x ps psubst (mbMap2 (:) mb_bp' mb_bps) mb_ps >>> - - -- Move the block permission we proved to the top of the stack - getTopDistPerm x >>>= \(ValPerm_Conj ps') -> - implSplitSwapConjsM x ps' 1 >>> - - -- Prove the disjunction of the two memblock permissions - partialSubstForceM mb_bp "proveVarLLVMBlock" >>>= \bp -> - let PExpr_OrShape sh1 sh2 = llvmBlockShape bp in - let introM = if is_case1 then introOrLM else introOrRM in - introM x (ValPerm_LLVMBlock $ bp { llvmBlockShape = sh1 }) - (ValPerm_LLVMBlock $ bp { llvmBlockShape = sh2 }) >>> - - -- Now coerce the disjunctive permission on top of the stack to an or shape, - -- and move it back into position - implSimplM Proxy (SImpl_IntroLLVMBlockOr - x (bp { llvmBlockShape = sh1 }) sh2) >>> - implSwapInsertConjM x (Perm_LLVMBlock bp) (tail ps') 0 - - - -- If proving an existential shape, introduce an evar and recurse - [nuMP| mb_bp : mb_bps |] - | [nuMP| PExpr_ExShape mb_mb_sh |] <- mbMatch $ fmap llvmBlockShape mb_bp -> - - -- Prove the sub-shape in the context of a new existential variable - let mb_bp' = - mbCombine RL.typeCtxProxies $ - mbMap2 (\bp mb_sh -> - fmap (\sh -> bp { llvmBlockShape = sh }) mb_sh) - mb_bp mb_mb_sh in - proveVarLLVMBlocksExt1 x ps psubst mb_bp' mb_bps mb_ps >>>= \e -> - - -- Move the block permission we proved to the top of the stack - getTopDistPerm x >>>= \(ValPerm_Conj ps') -> - implSplitSwapConjsM x ps' 1 >>> - - -- Prove an existential around the memblock permission we proved - partialSubstForceM (mbMap2 (,) - mb_bp mb_mb_sh) "proveVarLLVMBlock" >>>= \(bp,mb_sh) -> - introExistsM x e (fmap (\sh -> ValPerm_LLVMBlock $ - bp { llvmBlockShape = sh }) mb_sh) >>> - - -- Now coerce the existential permission on top of the stack to a memblock - -- perm with existential shape, and move it back into position - implSimplM Proxy (SImpl_IntroLLVMBlockEx x bp) >>> - implSwapInsertConjM x (Perm_LLVMBlock bp) (tail ps') 0 - - - -- If proving an evar shape that has already been set, substitute and recurse - [nuMP| mb_bp : mb_bps |] - | [nuMP| PExpr_Var mb_z |] <- mbMatch $ fmap llvmBlockShape mb_bp - , Left memb <- mbNameBoundP mb_z - , Just sh <- psubstLookup psubst memb -> - let mb_bp' = fmap (\bp -> bp { llvmBlockShape = sh }) mb_bp in - proveVarLLVMBlocks x ps psubst (mbMap2 (:) mb_bp' mb_bps) mb_ps - - - -- If z is unset and len == 0, just set z to the empty shape and recurse in - -- order to call the len == 0 empty shape case above - [nuMP| mb_bp : mb_bps |] - | [nuMP| PExpr_Var mb_z |] <- mbMatch $ fmap llvmBlockShape mb_bp - , Left memb <- mbNameBoundP mb_z - , Nothing <- psubstLookup psubst memb - , Just len <- partialSubst psubst (fmap llvmBlockLen mb_bp) - , bvIsZero len -> - setVarM memb PExpr_EmptyShape >>> - let mb_bp' = fmap (\bp -> bp { llvmBlockShape = PExpr_EmptyShape }) mb_bp in - proveVarLLVMBlocks x ps psubst (mbMap2 (:) mb_bp' mb_bps) mb_ps - - - -- If z is unset and there is a field permission with the required offset and - -- length, set z to a field shape with equality permission to an existential - -- variable, which is the most general field permission we can make - [nuMP| mb_bp : mb_bps |] - | [nuMP| PExpr_Var mb_z |] <- mbMatch $ fmap llvmBlockShape mb_bp - , Left memb <- mbNameBoundP mb_z - , Nothing <- psubstLookup psubst memb - , Just off <- partialSubst psubst (fmap llvmBlockOffset mb_bp) - , Just len <- partialSubst psubst (fmap llvmBlockLen mb_bp) - , Just i <- findIndex (isLLVMAtomicPermWithOffset off) ps - , Perm_LLVMField (fp :: LLVMFieldPerm w sz) <- ps!!i - , bvEq len (llvmFieldLen fp) -> - - -- Recursively prove a membblock with shape fieldsh(eq(y)) for fresh evar y - let mb_bp' = - mbCombine RL.typeCtxProxies $ flip fmap mb_bp $ \bp -> - nu $ \(y :: ExprVar (LLVMPointerType sz)) -> - bp { llvmBlockShape = - PExpr_FieldShape $ LLVMFieldShape $ - ValPerm_Eq $ PExpr_Var y } in - proveVarLLVMBlocksExt1 x ps psubst mb_bp' mb_bps mb_ps >>>= \e -> - - -- Set z = fieldsh(eq(e)) where e was the value we determined for y; - -- otherwise we are done, because our required block perm is already proved - -- and in the correct spot on the stack - setVarM memb (PExpr_FieldShape $ LLVMFieldShape $ ValPerm_Eq e) - - - -- If z is unset and there is an atomic permission with the required offset and - -- length (which is not a field permission, because otherwise the previous case - -- would match), set z to the shape of that atomic permission and recurse - [nuMP| mb_bp : mb_bps |] - | [nuMP| PExpr_Var mb_z |] <- mbMatch $ fmap llvmBlockShape mb_bp - , Left memb <- mbNameBoundP mb_z - , Nothing <- psubstLookup psubst memb - , Just off <- partialSubst psubst (fmap llvmBlockOffset mb_bp) - , Just len <- partialSubst psubst (fmap llvmBlockLen mb_bp) - , Just i <- findIndex (isLLVMAtomicPermWithOffset off) ps - , Just bp_lhs <- llvmAtomicPermToBlock (ps!!i) - , bvEq len (llvmBlockLen bp_lhs) - , sh_lhs <- llvmBlockShape bp_lhs -> - - setVarM memb sh_lhs >>> - let mb_bp' = fmap (\bp -> bp { llvmBlockShape = sh_lhs }) mb_bp in - proveVarLLVMBlocks x ps psubst (mbMap2 (:) mb_bp' mb_bps) mb_ps - - - -- If z is unset and there is an atomic permission with the required offset (but - -- not the required length, because otherwise it would have matched the previous - -- case), split our memblock permission into two memblock permissions with - -- unknown shapes but where the first has the length of this atomic permission - -- (so the previous case will match), and then recurse - [nuMP| mb_bp : mb_bps |] - | [nuMP| PExpr_Var mb_z |] <- mbMatch $ fmap llvmBlockShape mb_bp - , Left memb <- mbNameBoundP mb_z - , Nothing <- psubstLookup psubst memb - , Just off <- partialSubst psubst (fmap llvmBlockOffset mb_bp) - , Just i <- findIndex (isLLVMAtomicPermWithOffset off) ps - , Just len1 <- llvmAtomicPermLen (ps!!i) - , not (bvIsZero len1) -> - - -- Build existential memblock perms with fresh variables for shapes, where - -- the first one has the length of the atomic perm we found and the other - -- has the remaining length, and recurse - let mb_bps12 = - mbCombine RL.typeCtxProxies $ flip fmap mb_bp $ \bp -> - nuMulti (MNil :>: Proxy :>: Proxy) $ \(_ :>: z_sh1 :>: z_sh2) -> - [bp { llvmBlockLen = len1, llvmBlockShape = PExpr_Var z_sh1 }, - bp { llvmBlockOffset = bvAdd (llvmBlockOffset bp) len1, - llvmBlockLen = bvSub (llvmBlockLen bp) len1, - llvmBlockShape = PExpr_Var z_sh2 }] in - proveVarLLVMBlocksExt2 x ps psubst mb_bps12 mb_bps mb_ps >>> - - -- Move the two block permissions we proved to the top of the stack - getTopDistPerm x >>>= \(ValPerm_Conj ps_ret) -> - let (Perm_LLVMBlock bp1 : Perm_LLVMBlock bp2 : ps_ret') = ps_ret - len2 = llvmBlockLen bp2 - sh2 = llvmBlockShape bp2 in - implSplitSwapConjsM x ps_ret 2 >>> - implSplitConjsM x (map Perm_LLVMBlock [bp1,bp2]) 1 >>> - - -- Sequence these two block permissions together - implSimplM Proxy (SImpl_IntroLLVMBlockSeq x bp1 len2 sh2) >>> - let bp = bp1 { llvmBlockLen = bvAdd (llvmBlockLen bp1) len2, - llvmBlockShape = PExpr_SeqShape (llvmBlockShape bp1) sh2 } in - - -- Finally, set z to the memblock permission we ended up proving, and move - -- this proof back into position - setVarM memb (llvmBlockShape bp) >>> - implSwapInsertConjM x (Perm_LLVMBlock bp) ps_ret' 0 +-- If proving the empty shape for length 0, recursively prove everything else +-- and then use the empty introduction rule +proveVarLLVMBlocks2 x ps psubst mb_bp [nuMP| PExpr_EmptyShape |] mb_bps mb_ps + | Just len <- partialSubst psubst $ fmap llvmBlockLen mb_bp + , bvIsZero len = + + -- Do the recursive call without the empty shape and remember what + -- permissions it proved + proveVarLLVMBlocks x ps psubst mb_bps mb_ps >>> + getTopDistPerm x >>>= \(ValPerm_Conj ps_out) -> + + -- Substitute into the required block perm and prove it with + -- SImpl_IntroLLVMBlockEmpty + -- + -- FIXME: if the rwmodality or lifetime are still unset at this point, we + -- could set them to default values, but this will be a rare case + partialSubstForceM mb_bp "proveVarLLVMBlock" >>>= \bp -> + implSimplM Proxy (SImpl_IntroLLVMBlockEmpty x bp) >>> + + -- Finally, recombine the resulting permission with the rest of them + implSwapInsertConjM x (Perm_LLVMBlock bp) ps_out 0 + + +-- If proving the empty shape otherwise, prove an arbitrary memblock permission, +-- i.e., with shape y for evar y, and coerce it to the empty shape +proveVarLLVMBlocks2 x ps psubst mb_bp [nuMP| PExpr_EmptyShape |] mb_bps mb_ps = + -- Locally bind z_sh for the shape of the memblock perm and recurse + let mb_bp' = + mbCombine RL.typeCtxProxies $ flip fmap mb_bp $ \bp -> + nu $ \z_sh -> bp { llvmBlockShape = PExpr_Var z_sh } in + proveVarLLVMBlocksExt1 x ps psubst mb_bp' mb_bps mb_ps >>> + + -- Extract out the block perm we proved and coerce it to the empty shape + getTopDistPerm x >>>= \(ValPerm_Conj ps_out) -> + let (Perm_LLVMBlock bp : ps_out') = ps_out in + implSplitSwapConjsM x ps_out 1 >>> + implSimplM Proxy (SImpl_CoerceLLVMBlockEmpty x bp) >>> + + -- Finally, recombine the resulting permission with the rest of them + implSwapInsertConjM x (Perm_LLVMBlock $ + bp { llvmBlockShape = PExpr_EmptyShape }) ps_out' 0 + + +-- If proving a memblock permission (with shape other than emptysh, as it does +-- not match the above cases) whose length is longer than the natural length of +-- its shape, prove the memblock with the natural length as well as an +-- additional memblock with empty shape and then sequence them together. +proveVarLLVMBlocks2 x ps psubst mb_bp _ mb_bps mb_ps + | Just len <- partialSubst psubst (fmap llvmBlockLen mb_bp) + , mbLift $ fmap (maybe False (`bvLt` len) + . llvmShapeLength . llvmBlockShape) mb_bp = + + -- First, build the list of the correctly-sized perm + the empty shape one + let mb_bps' = + fmap (\bp -> + let sh_len = fromJust (llvmShapeLength (llvmBlockShape bp)) in + [bp { llvmBlockLen = sh_len }, + bp { llvmBlockOffset = bvAdd (llvmBlockOffset bp) sh_len, + llvmBlockLen = bvSub (llvmBlockLen bp) sh_len, + llvmBlockShape = PExpr_EmptyShape }]) mb_bp in + + -- Next, do the recursive call + proveVarLLVMBlocks x ps psubst (mbList mb_bps' ++ mb_bps) mb_ps >>> + + -- Move the correctly-sized perm + the empty shape one to the top of the + -- stack and sequence them, and then eliminate the empty shape at the end + getTopDistPerm x >>>= \(ValPerm_Conj ps') -> + let (Perm_LLVMBlock bp1 : Perm_LLVMBlock bp2 : ps'') = ps' + len2 = llvmBlockLen bp2 + bp_out = bp1 { llvmBlockLen = bvAdd (llvmBlockLen bp1) len2 } in + implSplitSwapConjsM x ps' 2 >>> + implSplitConjsM x [Perm_LLVMBlock bp1, Perm_LLVMBlock bp2] 1 >>> + implSimplM Proxy (SImpl_IntroLLVMBlockSeq x bp1 len2 PExpr_EmptyShape) >>> + implSimplM Proxy (SImpl_ElimLLVMBlockSeqEmpty x bp_out) >>> + + -- Finally, recombine the resulting permission with the rest of them + implSwapInsertConjM x (Perm_LLVMBlock bp_out) ps'' 0 + + +-- For an unfoldable named shape, prove its unfolding first and then fold it +proveVarLLVMBlocks2 x ps psubst mb_bp mb_sh mb_bps mb_ps + | [nuMP| PExpr_NamedShape rw l nmsh args |] <- mb_sh + , [nuMP| TrueRepr |] <- mbMatch $ fmap namedShapeCanUnfoldRepr nmsh + , [nuMP| Just mb_sh' |] <- mbMatch $ (mbMap3 unfoldModalizeNamedShape rw l nmsh + `mbApply` args) = + -- Recurse using the unfolded shape + (if mbLift (fmap namedShapeIsRecursive nmsh) then implSetRecRecurseRightM + else return ()) >>> + let mb_bp' = + mbMap2 (\bp sh' -> (bp { llvmBlockShape = sh' })) mb_bp mb_sh' in + proveVarLLVMBlocks x ps psubst (mb_bp' : mb_bps) mb_ps >>> + + -- Extract out the block perm we proved + getTopDistPerm x >>>= \(ValPerm_Conj ps_out) -> + let (Perm_LLVMBlock bp : ps_out') = ps_out in + implSplitSwapConjsM x ps_out 1 >>> + + -- Fold the named shape + partialSubstForceM (fmap + llvmBlockShape mb_bp) "proveVarLLVMBlocks" >>>= \sh -> + let bp' = bp { llvmBlockShape = sh } in + implIntroLLVMBlockNamed x bp' >>> + + -- Finally, recombine the resulting permission with the rest of them + implSwapInsertConjM x (Perm_LLVMBlock bp') ps_out' 0 + + +-- If proving an opaque named shape, the only way to prove the memblock +-- permission is to have it on the left, but we don't have a memblock permission +-- on the left with this exact offset, length, and shape, because it would have +-- matched some previous case, so try to eliminate a memblock and recurse +proveVarLLVMBlocks2 x ps psubst mb_bp mb_sh mb_bps mb_ps + | [nuMP| PExpr_NamedShape _ _ nmsh _ |] <- mb_sh + , [nuMP| FalseRepr |] <- mbMatch $ fmap namedShapeCanUnfoldRepr nmsh + , Just off <- partialSubst psubst $ fmap llvmBlockOffset mb_bp + , Just i <- findIndex (\case + p@(Perm_LLVMBlock _) -> + isJust (llvmPermContainsOffset off p) + _ -> False) ps + , Perm_LLVMBlock _ <- ps!!i = + implElimAppendIthLLVMBlock x ps i >>>= \ps' -> + proveVarLLVMBlocks x ps' psubst (mb_bp:mb_bps) mb_ps + + +-- If proving an equality shape eqsh(z) for evar z which has already been set, +-- substitute for z and recurse +proveVarLLVMBlocks2 x ps psubst mb_bp mb_sh mb_bps mb_ps + | [nuMP| PExpr_EqShape (PExpr_Var mb_z) |] <- mb_sh + , Left memb <- mbNameBoundP mb_z + , Just blk <- psubstLookup psubst memb = + proveVarLLVMBlocks x ps psubst + (fmap (\bp -> bp { llvmBlockShape = PExpr_EqShape blk }) mb_bp : mb_bps) + mb_ps + + +-- If proving an equality shape eqsh(z) for unset evar z, prove any memblock +-- perm with the given offset and length and eliminate it to an llvmblock with +-- an equality shape +proveVarLLVMBlocks2 x ps psubst mb_bp mb_sh mb_bps mb_ps + | [nuMP| PExpr_EqShape (PExpr_Var mb_z) |] <- mb_sh + , Left memb <- mbNameBoundP mb_z + , Nothing <- psubstLookup psubst memb = + -- Locally bind z_sh for the shape of the memblock perm and recurse + let mb_bp' = + mbCombine RL.typeCtxProxies $ flip fmap mb_bp $ \bp -> + nu $ \z_sh -> bp { llvmBlockShape = PExpr_Var z_sh } in + proveVarLLVMBlocksExt1 x ps psubst mb_bp' mb_bps mb_ps >>> + + -- Extract out the block perm we proved + getTopDistPerm x >>>= \(ValPerm_Conj ps_out) -> + let (Perm_LLVMBlock bp : ps_out') = ps_out in + implSplitSwapConjsM x ps_out 1 >>> + + -- Eliminate that block perm to have an equality shape, and set z to the + -- resulting block + implElimLLVMBlockToEq x bp >>>= \y_blk -> + let bp' = bp { llvmBlockShape = PExpr_EqShape $ PExpr_Var y_blk } in + setVarM memb (PExpr_Var y_blk) >>> + + -- Finally, recombine the resulting permission with the rest of them + implSwapInsertConjM x (Perm_LLVMBlock bp') ps_out' 0 + + +-- If z is a free variable, the only way to prove the memblock permission is to +-- have it on the left, but we don't have a memblock permission on the left with +-- this exactly offset, length, and shape, because it would have matched the +-- first case above, so try to eliminate a memblock and recurse +proveVarLLVMBlocks2 x ps psubst mb_bp mb_sh mb_bps mb_ps + | [nuMP| PExpr_EqShape (PExpr_Var mb_z) |] <- mb_sh + , Right _ <- mbNameBoundP mb_z + , Just off <- partialSubst psubst $ fmap llvmBlockOffset mb_bp + , Just i <- findIndex (\case + p@(Perm_LLVMBlock _) -> + isJust (llvmPermContainsOffset off p) + _ -> False) ps + , Perm_LLVMBlock _ <- ps!!i = + implElimAppendIthLLVMBlock x ps i >>>= \ps' -> + proveVarLLVMBlocks x ps' psubst (mb_bp:mb_bps) mb_ps + + +-- If proving a pointer shape, prove the required permission by adding it to ps; +-- this requires the pointed-to shape to have a well-defined length +proveVarLLVMBlocks2 x ps psubst mb_bp mb_sh mb_bps mb_ps + | [nuMP| PExpr_PtrShape mb_rw mb_l mb_sh' |] <- mb_sh + , mbLift $ fmap (isJust . llvmShapeLength) mb_sh' = + + -- Add a permission for a pointer to the required shape to mb_ps, and + -- recursively call proveVarLLVMBlocks to prove it and everything else + let mb_p_ptr = + mbMap4 (\bp maybe_rw maybe_l sh -> + (llvmBlockPtrAtomicPerm $ + llvmBlockAdjustModalities maybe_rw maybe_l $ + bp { llvmBlockLen = fromJust (llvmShapeLength sh), + llvmBlockShape = sh })) + mb_bp mb_rw mb_l mb_sh' in + proveVarLLVMBlocks x ps psubst mb_bps (mb_p_ptr:mb_ps) >>> + + -- Move the pointer permission we proved to the top of the stack + getTopDistPerm x >>>= \(ValPerm_Conj ps') -> + let i = length mb_bps in + implExtractSwapConjM x ps' i >>> + + -- Use the SImpl_IntroLLVMBlockPtr rule to prove the required memblock perm + partialSubstForceM mb_bp "proveVarLLVMBlocks" >>>= \bp -> + let PExpr_PtrShape maybe_rw maybe_l sh = llvmBlockShape bp in + let Just sh_len = llvmShapeLength sh in + implSimplM Proxy (SImpl_IntroLLVMBlockPtr x maybe_rw maybe_l $ + bp { llvmBlockLen = sh_len, llvmBlockShape = sh }) >>> + + -- Finally, move the memblock perm we proved back into position + implSwapInsertConjM x (Perm_LLVMBlock bp) (deleteNth i ps') 0 + + +-- If proving a field shape, prove the required permission by adding it to ps +proveVarLLVMBlocks2 x ps psubst mb_bp mb_sh mb_bps mb_ps + | [nuMP| PExpr_FieldShape (LLVMFieldShape mb_p) |] <- mb_sh = + + -- Add the field permission to the required permission to mb_ps, and + -- recursively call proveVarLLVMBlocks to prove it and everything else + let mb_fp = + mbMap2 (\bp p -> + (llvmBlockPtrFieldPerm bp) { llvmFieldContents = p }) + mb_bp mb_p in + let mb_p' = fmap Perm_LLVMField mb_fp in + proveVarLLVMBlocks x ps psubst mb_bps (mb_p':mb_ps) >>> + + -- Move the pointer permission we proved to the top of the stack + getTopDistPerm x >>>= \(ValPerm_Conj ps') -> + let i = length mb_bps in + implExtractSwapConjM x ps' i >>> + + -- Use the SImpl_IntroLLVMBlockField rule to prove the required memblock perm + partialSubstForceM (mbMap2 (,) + mb_bp mb_fp) "proveVarLLVMBlocks" >>>= \(bp,fp) -> + implSimplM Proxy (SImpl_IntroLLVMBlockField x fp) >>> - _ -> - implFailVarM "proveVarLLVMBlock" x (ValPerm_Conj ps) - (fmap ValPerm_Conj $ - mbMap2 (++) (fmap (map Perm_LLVMBlock) mb_bps_in) mb_ps) + -- Finally, move the memblock perm we proved back into position + implSwapInsertConjM x (Perm_LLVMBlock bp) (deleteNth i ps') 0 + + +-- If proving an array shape, just like in the field case, prove the required +-- array permission and then pad it out with an empty memblock permission +proveVarLLVMBlocks2 x ps psubst mb_bp mb_sh mb_bps mb_ps + | [nuMP| PExpr_ArrayShape _ _ _ |] <- mb_sh = + + -- Add the array permission to the required permission to mb_ps, and + -- recursively call proveVarLLVMBlocks to prove it and everything else + let mb_ap = fmap llvmArrayBlockToArrayPerm mb_bp in + let mb_p = fmap Perm_LLVMArray mb_ap in + proveVarLLVMBlocks x ps psubst mb_bps (mb_p:mb_ps) >>> + + -- Move the pointer permission we proved to the top of the stack + getTopDistPerm x >>>= \(ValPerm_Conj ps') -> + let i = length mb_bps in + implExtractSwapConjM x ps' i >>> + + -- Use the SImpl_IntroLLVMBlockArray rule to prove the memblock perm + partialSubstForceM (mbMap2 (,) + mb_bp mb_ap) "proveVarLLVMBlocks" >>>= \(bp,ap) -> + implSimplM Proxy (SImpl_IntroLLVMBlockArray x ap) >>> + + -- Finally, move the memblock perm we proved back into position + implSwapInsertConjM x (Perm_LLVMBlock bp) (deleteNth i ps') 0 + + +-- If proving a sequence shape, prove the two shapes and combine them; this +-- requires the first shape to have a well-defined length +proveVarLLVMBlocks2 x ps psubst mb_bp mb_sh mb_bps mb_ps + | [nuMP| PExpr_SeqShape mb_sh1 _ |] <- mb_sh + , mbLift $ fmap (isJust . llvmShapeLength) mb_sh1 = + + -- Add the two shapes to mb_bps and recursively call proveVarLLVMBlocks + let mb_bps12 = + fmap (\bp -> + let PExpr_SeqShape sh1 sh2 = llvmBlockShape bp in + let Just len1 = llvmShapeLength sh1 in + [bp { llvmBlockLen = len1, llvmBlockShape = sh1 }, + bp { llvmBlockOffset = bvAdd (llvmBlockOffset bp) len1, + llvmBlockLen = bvSub (llvmBlockLen bp) len1, + llvmBlockShape = sh2 }]) mb_bp in + proveVarLLVMBlocks x ps psubst (mbList mb_bps12 ++ mb_bps) mb_ps >>> + + -- Move the block permissions we proved to the top of the stack + getTopDistPerm x >>>= \(ValPerm_Conj ps') -> + let (Perm_LLVMBlock bp1 : Perm_LLVMBlock bp2 : ps'') = ps' + len2 = llvmBlockLen bp2 + sh2 = llvmBlockShape bp2 in + implSplitSwapConjsM x ps' 2 >>> + + -- Use the SImpl_IntroLLVMBlockSeq rule combine them into one memblock perm + implSplitConjsM x [Perm_LLVMBlock bp1, Perm_LLVMBlock bp2] 1 >>> + implSimplM Proxy (SImpl_IntroLLVMBlockSeq x bp1 len2 sh2) >>> + + -- Finally, move the memblock perm we proved back into position + partialSubstForceM mb_bp "proveVarLLVMBlock" >>>= \bp -> + implSwapInsertConjM x (Perm_LLVMBlock bp) ps'' 0 + + +-- If proving a tagged union shape where we have an equality permission on the +-- left that matches one of the disjuncts, prove that disjunct and or it up with +-- the other disjuncts +proveVarLLVMBlocks2 x ps psubst mb_bp _ mb_bps mb_ps + | [nuMP| Just mb_tag_u |] <- mbMatch $ fmap (asTaggedUnionShape + . llvmBlockShape) mb_bp + , Just off <- partialSubst psubst $ fmap llvmBlockOffset mb_bp + , Just i <- mbLift $ fmap (findTaggedUnionIndexForPerms off ps) mb_tag_u + , mb_shs <- fmap taggedUnionDisjs mb_tag_u + , mb_sh <- fmap (!!i) mb_shs = + + -- Recursively prove the ith disjunct + proveVarLLVMBlocks x ps psubst + (mbMap2 (\bp sh -> bp { llvmBlockShape = sh }) mb_bp mb_sh : mb_bps) + mb_ps >>> + + -- Move the block permission with shape mb_sh to the top of the stack + getTopDistPerm x >>>= \(ValPerm_Conj ps') -> + implExtractSwapConjM x ps' 0 >>> + + -- Finally, weaken the block permission to be the desired tagged union + -- shape, and move it back into position + partialSubstForceM mb_shs "proveVarLLVMBlock" >>>= \shs -> + partialSubstForceM mb_bp "proveVarLLVMBlock" >>>= \bp -> + implIntroOrShapeMultiM x bp shs i >>> + implSwapInsertConjM x (Perm_LLVMBlock bp) (tail ps') 0 + + +-- If proving a disjunctive shape, try to prove one of the disjuncts +proveVarLLVMBlocks2 x ps psubst mb_bp mb_sh mb_bps mb_ps + | [nuMP| PExpr_OrShape mb_sh1 mb_sh2 |] <- mb_sh = + + -- Build a computation that tries returning True here, and if that fails + -- returns False; True is used for sh1 while False is used for sh2 + implCatchM (pure True) (pure False) >>>= \is_case1 -> + + -- Prove the chosen shape by recursively calling proveVarLLVMBlocks + let mb_sh = if is_case1 then mb_sh1 else mb_sh2 in + let mb_bp' = mbMap2 (\bp sh -> bp { llvmBlockShape = sh }) mb_bp mb_sh in + proveVarLLVMBlocks x ps psubst (mb_bp' : mb_bps) mb_ps >>> + + -- Move the block permission we proved to the top of the stack + getTopDistPerm x >>>= \(ValPerm_Conj ps') -> + implSplitSwapConjsM x ps' 1 >>> + + -- Prove the disjunction of the two memblock permissions + partialSubstForceM mb_bp "proveVarLLVMBlock" >>>= \bp -> + let PExpr_OrShape sh1 sh2 = llvmBlockShape bp in + let introM = if is_case1 then introOrLM else introOrRM in + introM x (ValPerm_LLVMBlock $ bp { llvmBlockShape = sh1 }) + (ValPerm_LLVMBlock $ bp { llvmBlockShape = sh2 }) >>> + + -- Now coerce the disjunctive permission on top of the stack to an or shape, + -- and move it back into position + implSimplM Proxy (SImpl_IntroLLVMBlockOr + x (bp { llvmBlockShape = sh1 }) sh2) >>> + implSwapInsertConjM x (Perm_LLVMBlock bp) (tail ps') 0 + + +-- If proving an existential shape, introduce an evar and recurse +proveVarLLVMBlocks2 x ps psubst mb_bp mb_sh mb_bps mb_ps + | [nuMP| PExpr_ExShape mb_mb_sh' |] <- mb_sh = + + -- Prove the sub-shape in the context of a new existential variable + let mb_bp' = + mbCombine RL.typeCtxProxies $ + mbMap2 (\bp mb_sh' -> + fmap (\sh -> bp { llvmBlockShape = sh }) mb_sh') + mb_bp mb_mb_sh' in + proveVarLLVMBlocksExt1 x ps psubst mb_bp' mb_bps mb_ps >>>= \e -> + + -- Move the block permission we proved to the top of the stack + getTopDistPerm x >>>= \(ValPerm_Conj ps') -> + implSplitSwapConjsM x ps' 1 >>> + + -- Prove an existential around the memblock permission we proved + partialSubstForceM (mbMap2 (,) + mb_bp mb_mb_sh') "proveVarLLVMBlock" >>>= \(bp,mb_sh') -> + introExistsM x e (fmap (\sh -> ValPerm_LLVMBlock $ + bp { llvmBlockShape = sh }) mb_sh') >>> + + -- Now coerce the existential permission on top of the stack to a memblock + -- perm with existential shape, and move it back into position + implSimplM Proxy (SImpl_IntroLLVMBlockEx x bp) >>> + implSwapInsertConjM x (Perm_LLVMBlock bp) (tail ps') 0 + + +-- If proving an evar shape that has already been set, substitute and recurse +proveVarLLVMBlocks2 x ps psubst mb_bp mb_sh mb_bps mb_ps + | [nuMP| PExpr_Var mb_z |] <- mb_sh + , Left memb <- mbNameBoundP mb_z + , Just sh <- psubstLookup psubst memb = + let mb_bp' = fmap (\bp -> bp { llvmBlockShape = sh }) mb_bp in + proveVarLLVMBlocks x ps psubst (mb_bp' : mb_bps) mb_ps + + +-- If z is unset and len == 0, just set z to the empty shape and recurse in +-- order to call the len == 0 empty shape case above +proveVarLLVMBlocks2 x ps psubst mb_bp mb_sh mb_bps mb_ps + | [nuMP| PExpr_Var mb_z |] <- mb_sh + , Left memb <- mbNameBoundP mb_z + , Nothing <- psubstLookup psubst memb + , Just len <- partialSubst psubst (fmap llvmBlockLen mb_bp) + , bvIsZero len = + setVarM memb PExpr_EmptyShape >>> + let mb_bp' = fmap (\bp -> bp { llvmBlockShape = PExpr_EmptyShape }) mb_bp in + proveVarLLVMBlocks x ps psubst (mb_bp' : mb_bps) mb_ps + + +-- If z is unset and there is a field permission with the required offset and +-- length, set z to a field shape with equality permission to an existential +-- variable, which is the most general field permission we can make +proveVarLLVMBlocks2 x ps psubst mb_bp mb_sh mb_bps mb_ps + | [nuMP| PExpr_Var mb_z |] <- mb_sh + , Left memb <- mbNameBoundP mb_z + , Nothing <- psubstLookup psubst memb + , Just off <- partialSubst psubst (fmap llvmBlockOffset mb_bp) + , Just len <- partialSubst psubst (fmap llvmBlockLen mb_bp) + , Just i <- findIndex (isLLVMAtomicPermWithOffset off) ps + , Perm_LLVMField (fp :: LLVMFieldPerm w sz) <- ps!!i + , bvEq len (llvmFieldLen fp) = + + -- Recursively prove a membblock with shape fieldsh(eq(y)) for fresh evar y + let mb_bp' = + mbCombine RL.typeCtxProxies $ flip fmap mb_bp $ \bp -> + nu $ \(y :: ExprVar (LLVMPointerType sz)) -> + bp { llvmBlockShape = + PExpr_FieldShape $ LLVMFieldShape $ + ValPerm_Eq $ PExpr_Var y } in + proveVarLLVMBlocksExt1 x ps psubst mb_bp' mb_bps mb_ps >>>= \e -> + + -- Set z = fieldsh(eq(e)) where e was the value we determined for y; + -- otherwise we are done, because our required block perm is already proved + -- and in the correct spot on the stack + setVarM memb (PExpr_FieldShape $ LLVMFieldShape $ ValPerm_Eq e) + + +-- If z is unset and there is an atomic permission with the required offset and +-- length (which is not a field permission, because otherwise the previous case +-- would match), set z to the shape of that atomic permission and recurse +proveVarLLVMBlocks2 x ps psubst mb_bp mb_sh mb_bps mb_ps + | [nuMP| PExpr_Var mb_z |] <- mb_sh + , Left memb <- mbNameBoundP mb_z + , Nothing <- psubstLookup psubst memb + , Just off <- partialSubst psubst (fmap llvmBlockOffset mb_bp) + , Just len <- partialSubst psubst (fmap llvmBlockLen mb_bp) + , Just i <- findIndex (isLLVMAtomicPermWithOffset off) ps + , Just bp_lhs <- llvmAtomicPermToBlock (ps!!i) + , bvEq len (llvmBlockLen bp_lhs) + , sh_lhs <- llvmBlockShape bp_lhs = + + setVarM memb sh_lhs >>> + let mb_bp' = fmap (\bp -> bp { llvmBlockShape = sh_lhs }) mb_bp in + proveVarLLVMBlocks x ps psubst (mb_bp' : mb_bps) mb_ps + + +-- If z is unset and there is an atomic permission with the required offset (but +-- not the required length, because otherwise it would have matched the previous +-- case), split our memblock permission into two memblock permissions with +-- unknown shapes but where the first has the length of this atomic permission +-- (so the previous case will match), and then recurse +proveVarLLVMBlocks2 x ps psubst mb_bp mb_sh mb_bps mb_ps + | [nuMP| PExpr_Var mb_z |] <- mb_sh + , Left memb <- mbNameBoundP mb_z + , Nothing <- psubstLookup psubst memb + , Just off <- partialSubst psubst (fmap llvmBlockOffset mb_bp) + , Just i <- findIndex (isLLVMAtomicPermWithOffset off) ps + , Just len1 <- llvmAtomicPermLen (ps!!i) + , not (bvIsZero len1) = + + -- Build existential memblock perms with fresh variables for shapes, where + -- the first one has the length of the atomic perm we found and the other + -- has the remaining length, and recurse + let mb_bps12 = + mbCombine RL.typeCtxProxies $ flip fmap mb_bp $ \bp -> + nuMulti (MNil :>: Proxy :>: Proxy) $ \(_ :>: z_sh1 :>: z_sh2) -> + [bp { llvmBlockLen = len1, llvmBlockShape = PExpr_Var z_sh1 }, + bp { llvmBlockOffset = bvAdd (llvmBlockOffset bp) len1, + llvmBlockLen = bvSub (llvmBlockLen bp) len1, + llvmBlockShape = PExpr_Var z_sh2 }] in + proveVarLLVMBlocksExt2 x ps psubst mb_bps12 mb_bps mb_ps >>> + + -- Move the two block permissions we proved to the top of the stack + getTopDistPerm x >>>= \(ValPerm_Conj ps_ret) -> + let (Perm_LLVMBlock bp1 : Perm_LLVMBlock bp2 : ps_ret') = ps_ret + len2 = llvmBlockLen bp2 + sh2 = llvmBlockShape bp2 in + implSplitSwapConjsM x ps_ret 2 >>> + implSplitConjsM x (map Perm_LLVMBlock [bp1,bp2]) 1 >>> + + -- Sequence these two block permissions together + implSimplM Proxy (SImpl_IntroLLVMBlockSeq x bp1 len2 sh2) >>> + let bp = bp1 { llvmBlockLen = bvAdd (llvmBlockLen bp1) len2, + llvmBlockShape = PExpr_SeqShape (llvmBlockShape bp1) sh2 } in + + -- Finally, set z to the memblock permission we ended up proving, and move + -- this proof back into position + setVarM memb (llvmBlockShape bp) >>> + implSwapInsertConjM x (Perm_LLVMBlock bp) ps_ret' 0 + + +proveVarLLVMBlocks2 x ps _ mb_bp _ mb_bps mb_ps = + mbSubstM (\s -> + ValPerm_Conj (map (Perm_LLVMBlock . s) (mb_bp:mb_bps) + ++ map s mb_ps)) >>>= \mb_bps_ps -> + implFailVarM "proveVarLLVMBlock" x (ValPerm_Conj ps) mb_bps_ps ---------------------------------------------------------------------- From 676c07f5c1715ddd6b4111fbf65afac9a23d21bc Mon Sep 17 00:00:00 2001 From: Eddy Westbrook Date: Fri, 6 Aug 2021 09:31:57 -0700 Subject: [PATCH 14/28] whoops, forgot to change a shadowed variable... --- heapster-saw/src/Verifier/SAW/Heapster/Implication.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/heapster-saw/src/Verifier/SAW/Heapster/Implication.hs b/heapster-saw/src/Verifier/SAW/Heapster/Implication.hs index 337b754487..1cb8c5fa98 100644 --- a/heapster-saw/src/Verifier/SAW/Heapster/Implication.hs +++ b/heapster-saw/src/Verifier/SAW/Heapster/Implication.hs @@ -5821,8 +5821,8 @@ proveVarLLVMBlocks2 x ps psubst mb_bp mb_sh mb_bps mb_ps implCatchM (pure True) (pure False) >>>= \is_case1 -> -- Prove the chosen shape by recursively calling proveVarLLVMBlocks - let mb_sh = if is_case1 then mb_sh1 else mb_sh2 in - let mb_bp' = mbMap2 (\bp sh -> bp { llvmBlockShape = sh }) mb_bp mb_sh in + let mb_sh' = if is_case1 then mb_sh1 else mb_sh2 in + let mb_bp' = mbMap2 (\bp sh -> bp { llvmBlockShape = sh }) mb_bp mb_sh' in proveVarLLVMBlocks x ps psubst (mb_bp' : mb_bps) mb_ps >>> -- Move the block permission we proved to the top of the stack From ed50023d05f99311771cddec28b7c6c743041b58 Mon Sep 17 00:00:00 2001 From: Eddy Westbrook Date: Fri, 6 Aug 2021 09:32:12 -0700 Subject: [PATCH 15/28] implemented a few more suggestions from Eric Mertens --- .../src/Verifier/SAW/Heapster/Permissions.hs | 32 ++++++++++++------- 1 file changed, 21 insertions(+), 11 deletions(-) diff --git a/heapster-saw/src/Verifier/SAW/Heapster/Permissions.hs b/heapster-saw/src/Verifier/SAW/Heapster/Permissions.hs index 33ef9d8d63..ffb297e65d 100644 --- a/heapster-saw/src/Verifier/SAW/Heapster/Permissions.hs +++ b/heapster-saw/src/Verifier/SAW/Heapster/Permissions.hs @@ -31,6 +31,7 @@ import Prelude hiding (pred) import Data.Char (isDigit) import Data.Maybe +import Data.Foldable (asum) import Data.List hiding (sort) import Data.List.NonEmpty (NonEmpty(..)) import qualified Data.List.NonEmpty as NonEmpty @@ -3530,7 +3531,7 @@ data TaggedUnionShape w -- | Extract the disjunctive shapes from a 'TaggedUnionShape' taggedUnionDisjs :: TaggedUnionShape w -> [PermExpr (LLVMShapeType w)] taggedUnionDisjs (TaggedUnionShape disjs) = - snd $ unzip $ NonEmpty.toList disjs + map snd $ NonEmpty.toList disjs -- | Convert a 'TaggedUnionShape' to the shape it represents taggedUnionToShape :: TaggedUnionShape w -> PermExpr (LLVMShapeType w) @@ -3569,6 +3570,23 @@ asTaggedUnionShape sh Just (TaggedUnionShape ((bv,sh) :| [])) asTaggedUnionShape _ = Nothing +-- | Find a disjunct in a 'TaggedUnionShape' that could be proven at the given +-- offset from the given atomic permission, by checking if it is a field or +-- block permission containing an equality permission to one of the tags. If +-- some disjunct can be proved, return its index in the list of disjuncts. +findTaggedUnionIndexForPerm :: PermExpr (BVType w) -> + AtomicPerm (LLVMPointerType w) -> + TaggedUnionShape w -> Maybe Int +findTaggedUnionIndexForPerm off p (TaggedUnionShape disjs@((bv1,_) :| _)) + | Just bp <- llvmAtomicPermToBlock p + , bvEq off (llvmBlockOffset bp) + , Just (SomeBV tag_bv) <- getShapeBVTag $ llvmBlockShape bp + , Just Refl <- testEquality (natRepr tag_bv) (natRepr bv1) + , Just i <- findIndex (== tag_bv) $ map fst $ NonEmpty.toList disjs + = Just i +findTaggedUnionIndexForPerm _ _ _ = Nothing + + -- | Find a disjunct in a 'TaggedUnionShape' that could be proven at the given -- offset from the given atomic permissions, by looking for a field or block -- permission containing an equality permission to one of the tags. If some @@ -3576,16 +3594,8 @@ asTaggedUnionShape _ = Nothing findTaggedUnionIndexForPerms :: PermExpr (BVType w) -> [AtomicPerm (LLVMPointerType w)] -> TaggedUnionShape w -> Maybe Int -findTaggedUnionIndexForPerms off (p : _) (TaggedUnionShape disjs@((bv1,_) :| _)) - | Just bp <- llvmAtomicPermToBlock p - , bvEq off (llvmBlockOffset bp) - , Just (SomeBV tag_bv) <- getShapeBVTag $ llvmBlockShape bp - , Just Refl <- testEquality (natRepr tag_bv) (natRepr bv1) - , Just i <- findIndex (== tag_bv) $ fst $ unzip $ NonEmpty.toList disjs - = Just i -findTaggedUnionIndexForPerms off (_ : ps) tag_u = - findTaggedUnionIndexForPerms off ps tag_u -findTaggedUnionIndexForPerms _ [] _ = Nothing +findTaggedUnionIndexForPerms off ps tag_un = + asum $ map (\p -> findTaggedUnionIndexForPerm off p tag_un) ps -- | Convert an array cell number @cell@ to the byte offset for that cell, given From 5a163916b30b6f263aab3b7dc9b253f20fa7abc8 Mon Sep 17 00:00:00 2001 From: Eddy Westbrook Date: Fri, 6 Aug 2021 12:43:32 -0700 Subject: [PATCH 16/28] fixed an infinite loop in proving the new lowned permissions; also added helper function implPushCopyM --- .../src/Verifier/SAW/Heapster/Implication.hs | 67 ++++++++----------- 1 file changed, 29 insertions(+), 38 deletions(-) diff --git a/heapster-saw/src/Verifier/SAW/Heapster/Implication.hs b/heapster-saw/src/Verifier/SAW/Heapster/Implication.hs index ba692520e2..b9c70eefd6 100644 --- a/heapster-saw/src/Verifier/SAW/Heapster/Implication.hs +++ b/heapster-saw/src/Verifier/SAW/Heapster/Implication.hs @@ -66,13 +66,6 @@ import GHC.Stack import Debug.Trace -{- FIXME HERE NOW: -- add contained lifetimes to lowned perms -- remove LOwnedPermLifetime constructor -- change the rules SplitLifetime, SubsumeLifetime, MapLifetime, - EndLifetime, and BeginLifetime --} - ---------------------------------------------------------------------- -- * Equality Proofs ---------------------------------------------------------------------- @@ -766,8 +759,8 @@ data SimplImpl ps_in ps_out where -- | Save a permission for later by splitting it into part that is in the -- current lifetime and part that is saved in the lifetime for later: -- - -- > x:F * l:[l2]lcurrent * l2:lowned (ps_in -o ps_out) - -- > -o x:F * l2:lowned (x:F, ps_in -o x:F, ps_out) + -- > x:F * l:[l2]lcurrent * l2:lowned[ls] (ps_in -o ps_out) + -- > -o x:F * l2:lowned[ls](x:F, ps_in -o x:F, ps_out) -- -- Note that this rule also supports @l=always@, in which case the -- @l:[l2]lcurrent@ permission is replaced by @l2:true@ (as a hack, because it @@ -3288,6 +3281,12 @@ implCopyM :: NuMatchingAny1 r => ExprVar a -> ValuePerm a -> ImplM vars s r (ps :> a :> a) (ps :> a) () implCopyM x p = implSimplM Proxy (SImpl_Copy x p) +-- | Push a copyable permission using 'implPushM', copy that permission, and +-- then pop it back to the variable permission for @x@ +implPushCopyM :: NuMatchingAny1 r => ExprVar a -> ValuePerm a -> + ImplM vars s r (ps :> a) ps () +implPushCopyM x p = implPushM x p >>> implCopyM x p >>> implPopM x p + -- | Swap the top two permissions on the top of the stack implSwapM :: NuMatchingAny1 r => ExprVar a -> ValuePerm a -> ExprVar b -> ValuePerm b -> @@ -3469,8 +3468,7 @@ implProveEqPerms (DistPermsCons ps' x (ValPerm_Eq (PExpr_Var y))) | x == y = implProveEqPerms ps' >>> introEqReflM x implProveEqPerms (DistPermsCons ps' x p@(ValPerm_Eq _)) = - implProveEqPerms ps' >>> - implPushM x p >>> implCopyM x p >>> implPopM x p + implProveEqPerms ps' >>> implPushCopyM x p implProveEqPerms _ = error "implProveEqPerms: non-equality permission" -- | Cast a proof of @x:p@ to one of @x:p'@ using a proof that @p=p'@ @@ -3777,10 +3775,11 @@ implContainedLifetimeCurrentM l ls ps_in ps_out l2 = -- | Remove a finshed contained lifetime from an @lowned@ permission. Assume the -- permissions -- --- > l1:lowned[ls1,l2,ls2] (ps_in -o ps_out) * l2:lfinished +-- > l1:lowned[ls] (ps_in -o ps_out) * l2:lfinished -- --- are on top of the stack, and remove @l2@ from the contained lifetimes of --- @l1@, popping the resulting @lowned@ permission on @l1@ off of the stack. +-- are on top of the stack where @l2@ is in @ls@, and remove @l2@ from the +-- contained lifetimes @ls@ of @l1@, popping the resulting @lowned@ permission +-- on @l1@ off of the stack. implRemoveContainedLifetimeM :: NuMatchingAny1 r => ExprVar LifetimeType -> [PermExpr LifetimeType] -> LOwnedPerms ps_in -> LOwnedPerms ps_out -> @@ -4201,9 +4200,7 @@ proveLifetimeCurrent (CurrentTransPerms cur_perms l) = proveLifetimeCurrent cur_perms >>> let l' = lifetimeCurrentPermsLifetime cur_perms p_l_cur = ValPerm_LCurrent l' in - implPushM l p_l_cur >>> - implCopyM l p_l_cur >>> - implPopM l p_l_cur + implPushCopyM l p_l_cur ---------------------------------------------------------------------- @@ -4217,15 +4214,12 @@ simplEqPerm :: NuMatchingAny1 r => ExprVar a -> PermExpr a -> ImplM vars s r (as :> a) (as :> a) (PermExpr a) simplEqPerm x e@(PExpr_Var y) = getPerm y >>= \case - p@(ValPerm_Eq e') -> - implPushM y p >>> implCopyM y p >>> implPopM y p >>> - introCastM x y p >>> pure e' + p@(ValPerm_Eq e') -> implPushCopyM y p >>> introCastM x y p >>> pure e' _ -> pure e simplEqPerm x e@(PExpr_LLVMOffset y off) = getPerm y >>= \case p@(ValPerm_Eq e') -> - implPushM y p >>> implCopyM y p >>> implPopM y p >>> - castLLVMPtrM y p off x >>> pure (addLLVMOffset e' off) + implPushCopyM y p >>> castLLVMPtrM y p off x >>> pure (addLLVMOffset e' off) _ -> pure e simplEqPerm _ e = pure e @@ -4259,12 +4253,12 @@ recombinePerm' x (ValPerm_Eq (PExpr_Var y)) _ recombinePerm' x (ValPerm_Eq e1) p@(ValPerm_Eq e2) | e1 == e2 = implDropM x p recombinePerm' x x_p@(ValPerm_Eq (PExpr_Var y)) p = - implPushM x x_p >>> introEqCopyM x (PExpr_Var y) >>> implPopM x x_p >>> + implPushCopyM x x_p >>> invertEqM x y >>> implSwapM x p y (ValPerm_Eq (PExpr_Var x)) >>> introCastM y x p >>> getPerm y >>>= \y_p -> recombinePermExpl y y_p p recombinePerm' x x_p@(ValPerm_Eq (PExpr_LLVMOffset y off)) (ValPerm_Conj ps) = - implPushM x x_p >>> introEqCopyM x (PExpr_LLVMOffset y off) >>> - implPopM x x_p >>> implSimplM Proxy (SImpl_InvertLLVMOffsetEq x off y) >>> + implPushCopyM x x_p >>> + implSimplM Proxy (SImpl_InvertLLVMOffsetEq x off y) >>> implSwapM x (ValPerm_Conj ps) y (ValPerm_Eq (PExpr_LLVMOffset x (bvNegate off))) >>> castLLVMPtrM x (ValPerm_Conj ps) (bvNegate off) y >>> @@ -6232,9 +6226,9 @@ proveVarAtomicImpl x ps mb_p = case mbMatch mb_p of -- FIXME HERE: eventually we should handle lowned permissions on the right -- with arbitrary contained lifetimes, by equalizing the two sides [nuMP| Perm_LOwned [] _ _ |] - | [Perm_LOwned (mapM asVar -> Just ls) _ _] <- ps -> - implPopM x (ValPerm_Conj ps) >>> - mapM_ implEndLifetimeRecM ls >>> + | [Perm_LOwned ls@(PExpr_Var l2:_) ps_in ps_out] <- ps -> + implEndLifetimeRecM l2 >>> + implRemoveContainedLifetimeM x ls ps_in ps_out l2 >>> proveVarImplInt x (fmap ValPerm_Conj1 mb_p) [nuMP| Perm_LOwned [] mb_ps_inR mb_ps_outR |] @@ -6323,9 +6317,7 @@ proveVarAtomicImpl x ps mb_p = case mbMatch mb_p of _ -> proveVarAtomicImplUnfoldOrFail x ps mb_p [nuMP| Perm_LFinished |] -> - implPopM x (ValPerm_Conj ps) >>> implEndLifetimeRecM x >>> - implPushM x ValPerm_LFinished >>> implCopyM x ValPerm_LFinished >>> - implPopM x ValPerm_LFinished + implPopM x (ValPerm_Conj ps) >>> implEndLifetimeRecM x -- If we have a struct permission on the left, eliminate it to a sequence of -- variables and prove the required permissions for each variable @@ -6959,24 +6951,23 @@ localProveVars ps_in ps_out = -- @lowned@ permissions are held for all of those lifetimes. For each lifetime -- that is ended, prove its required input permissions and recombine the -- resulting output permissions. If a lifetime has already ended, do nothing. +-- Leave an @lfinished@ permission for that lifetime on the top of the stack. implEndLifetimeRecM :: NuMatchingAny1 r => ExprVar LifetimeType -> - ImplM vars s r ps ps () + ImplM vars s r (ps :> LifetimeType) ps () implEndLifetimeRecM l = getPerm l >>>= \case - ValPerm_LFinished -> return () + p@ValPerm_LFinished -> implPushCopyM l p p@(ValPerm_LOwned [] ps_in ps_out) | Just dps_in <- lownedPermsToDistPerms ps_in -> mbVarsM dps_in >>>= \mb_dps_in -> -- NOTE: we are assuming that l's permission, p, will not change during -- this recursive call to the prover, which should be safe proveVarsImplAppendInt mb_dps_in >>> - implPushM l p >>> - implEndLifetimeM Proxy l ps_in ps_out + implPushM l p >>> implEndLifetimeM Proxy l ps_in ps_out >>> + implPushCopyM l ValPerm_LFinished p@(ValPerm_LOwned ((asVar -> Just l') : ls) ps_in ps_out) -> implPushM l p >>> implEndLifetimeRecM l' >>> - implPushM l' ValPerm_LFinished >>> implCopyM l' ValPerm_LFinished >>> - implPopM l' ValPerm_LFinished >>> implRemoveContainedLifetimeM l ls ps_in ps_out l' >>> implEndLifetimeRecM l _ -> @@ -7005,7 +6996,7 @@ proveVarsImplAppend mb_ps = sep [pretty "Ending lifetime" <+> permPretty i l, pretty "in order to prove:", permPretty i mb_ps]) >>> - implEndLifetimeRecM l >>> + implEndLifetimeRecM l >>> implDropM l ValPerm_LFinished >>> proveVarsImplAppend mb_ps)) -- | Prove a list of existentially-quantified distinguished permissions and put From 820b846c7d4aca98073f0a5ea170e415493b7d92 Mon Sep 17 00:00:00 2001 From: Eddy Westbrook Date: Fri, 6 Aug 2021 13:07:53 -0700 Subject: [PATCH 17/28] updated the translation for the new lfinished permission and the modified lowned permission, along with all the new and modified rules; also removed a bunch of whitespace from a previous commit --- .../Verifier/SAW/Heapster/SAWTranslation.hs | 360 +++++++++--------- 1 file changed, 188 insertions(+), 172 deletions(-) diff --git a/heapster-saw/src/Verifier/SAW/Heapster/SAWTranslation.hs b/heapster-saw/src/Verifier/SAW/Heapster/SAWTranslation.hs index 9da457a795..5a3ffad2cb 100644 --- a/heapster-saw/src/Verifier/SAW/Heapster/SAWTranslation.hs +++ b/heapster-saw/src/Verifier/SAW/Heapster/SAWTranslation.hs @@ -937,7 +937,8 @@ data AtomicPermTrans ctx a where -- | LOwned permissions translate to a monadic function from (the translation -- of) the input permissions to the output permissions - APTrans_LOwned :: Mb ctx (LOwnedPerms ps_in) -> + APTrans_LOwned :: Mb ctx [PermExpr LifetimeType] -> + Mb ctx (LOwnedPerms ps_in) -> Mb ctx (LOwnedPerms ps_out) -> OpenTerm -> AtomicPermTrans ctx LifetimeType @@ -945,6 +946,9 @@ data AtomicPermTrans ctx a where APTrans_LCurrent :: Mb ctx (PermExpr LifetimeType) -> AtomicPermTrans ctx LifetimeType + -- | LFinished permissions have no computational content + APTrans_LFinished :: AtomicPermTrans ctx LifetimeType + -- | The translation of a struct permission is sequence of the translations of -- the permissions in the struct permission APTrans_Struct :: PermTransCtx ctx (CtxToRList args) -> @@ -1101,8 +1105,9 @@ instance IsTermTrans (AtomicPermTrans ctx a) where transTerms (APTrans_NamedConj _ _ _ t) = [t] transTerms (APTrans_DefinedNamedConj _ _ _ ptrans) = transTerms ptrans transTerms (APTrans_LLVMFrame _) = [] - transTerms (APTrans_LOwned _ _ t) = [t] + transTerms (APTrans_LOwned _ _ _ t) = [t] transTerms (APTrans_LCurrent _) = [] + transTerms APTrans_LFinished = [] transTerms (APTrans_Struct pctx) = transTerms pctx transTerms (APTrans_Fun _ t) = [t] transTerms (APTrans_BVProp prop) = transTerms prop @@ -1156,9 +1161,10 @@ atomicPermTransPerm _ (APTrans_NamedConj npn args off _) = atomicPermTransPerm _ (APTrans_DefinedNamedConj npn args off _) = mbMap2 (Perm_NamedConj npn) args off atomicPermTransPerm _ (APTrans_LLVMFrame fp) = fmap Perm_LLVMFrame fp -atomicPermTransPerm _ (APTrans_LOwned ps_in ps_out _) = - mbMap2 Perm_LOwned ps_in ps_out +atomicPermTransPerm _ (APTrans_LOwned ls ps_in ps_out _) = + mbMap3 Perm_LOwned ls ps_in ps_out atomicPermTransPerm _ (APTrans_LCurrent l) = fmap Perm_LCurrent l +atomicPermTransPerm prxs APTrans_LFinished = nus prxs $ const Perm_LFinished atomicPermTransPerm prxs (APTrans_Struct ps) = fmap Perm_Struct $ permTransCtxPerms prxs ps atomicPermTransPerm _ (APTrans_Fun fp _) = fmap Perm_Fun fp @@ -1217,9 +1223,10 @@ instance ExtPermTrans AtomicPermTrans where extPermTrans (APTrans_DefinedNamedConj npn args off ptrans) = APTrans_DefinedNamedConj npn (extMb args) (extMb off) (extPermTrans ptrans) extPermTrans (APTrans_LLVMFrame fp) = APTrans_LLVMFrame $ extMb fp - extPermTrans (APTrans_LOwned ps_in ps_out t) = - APTrans_LOwned (extMb ps_in) (extMb ps_out) t + extPermTrans (APTrans_LOwned ls ps_in ps_out t) = + APTrans_LOwned (extMb ls) (extMb ps_in) (extMb ps_out) t extPermTrans (APTrans_LCurrent p) = APTrans_LCurrent $ extMb p + extPermTrans APTrans_LFinished = APTrans_LFinished extPermTrans (APTrans_Struct ps) = APTrans_Struct $ RL.map extPermTrans ps extPermTrans (APTrans_Fun fp t) = APTrans_Fun (extMb fp) t extPermTrans (APTrans_BVProp prop_trans) = @@ -1629,15 +1636,17 @@ instance TransInfo info => APTrans_NamedConj (mbLift npn) args off t) ptrans [nuMP| Perm_LLVMFrame fp |] -> return $ mkTypeTrans0 $ APTrans_LLVMFrame fp - [nuMP| Perm_LOwned ps_in ps_out |] -> + [nuMP| Perm_LOwned ls ps_in ps_out |] -> do tp_in <- translate1 ps_in tp_out <- translate1 ps_out let tp = arrowOpenTerm "ps" tp_in (applyOpenTerm (globalOpenTerm "Prelude.CompM") tp_out) - return $ mkTypeTrans1 tp (APTrans_LOwned ps_in ps_out) + return $ mkTypeTrans1 tp (APTrans_LOwned ls ps_in ps_out) [nuMP| Perm_LCurrent l |] -> return $ mkTypeTrans0 $ APTrans_LCurrent l + [nuMP| Perm_LFinished |] -> + return $ mkTypeTrans0 APTrans_LFinished [nuMP| Perm_Struct ps |] -> fmap APTrans_Struct <$> translate ps [nuMP| Perm_Fun fun_perm |] -> @@ -2059,15 +2068,15 @@ translateSimplImpl :: Proxy ps -> Mb ctx (SimplImpl ps_in ps_out) -> translateSimplImpl (ps0 :: Proxy ps0) mb_simpl m = case mbMatch mb_simpl of [nuMP| SImpl_Drop _ _ |] -> withPermStackM (\(xs :>: _) -> xs) (\(ps :>: _) -> ps) m - + [nuMP| SImpl_Copy x _ |] -> withPermStackM (:>: translateVar x) (\(ps :>: p) -> ps :>: p :>: p) m - + [nuMP| SImpl_Swap _ _ _ _ |] -> withPermStackM (\(xs :>: x :>: y) -> xs :>: y :>: x) (\(pctx :>: px :>: py) -> pctx :>: py :>: px) m - + [nuMP| SImpl_MoveUp (mb_ps1 :: DistPerms ps1) (_mb_x :: ExprVar a) _ (mb_ps2 :: DistPerms ps2) |] -> let ps1 = mbRAssignProxies mb_ps1 @@ -2087,7 +2096,7 @@ translateSimplImpl (ps0 :: Proxy ps0) mb_simpl m = case mbMatch mb_simpl of (pctx1, pctx2) = RL.split ps1 ps2 pctx12 in RL.append pctx0 $ RL.append (pctx1 :>: ptrans) pctx2) m - + [nuMP| SImpl_MoveDown mb_ps1 (mb_x :: ExprVar a) _ mb_ps2 |] | prx_a <- mbLift $ fmap (const (Proxy :: Proxy a)) mb_x , ps1 <- mbRAssignProxies mb_ps1 @@ -2112,7 +2121,7 @@ translateSimplImpl (ps0 :: Proxy ps0) mb_simpl m = case mbMatch mb_simpl of (\(ps :>: p_top) -> ps :>: PTrans_Term (mbMap2 ValPerm_Or p1 p2) (leftTrans tp1 tp2 p_top)) m - + [nuMP| SImpl_IntroOrR _ p1 p2 |] -> do tp1 <- translate p1 tp2 <- translate p2 @@ -2120,7 +2129,7 @@ translateSimplImpl (ps0 :: Proxy ps0) mb_simpl m = case mbMatch mb_simpl of (\(ps :>: p_top) -> ps :>: PTrans_Term (mbMap2 ValPerm_Or p1 p2) (rightTrans tp1 tp2 p_top)) m - + [nuMP| SImpl_IntroExists _ e p |] -> do let tp = mbExprType e tp_trans <- translateClosed tp @@ -2131,12 +2140,12 @@ translateSimplImpl (ps0 :: Proxy ps0) mb_simpl m = case mbMatch mb_simpl of withPermStackM id ((:>: PTrans_Term (fmap ValPerm_Exists p) sigma_trm) . RL.tail) m - + [nuMP| SImpl_Cast _ _ _ |] -> withPermStackM RL.tail (\(pctx :>: _ :>: ptrans) -> pctx :>: ptrans) m - + [nuMP| SImpl_CastPerm (x::ExprVar a) eqp |] -> do ttrans <- translate $ fmap (distPermsHeadPerm . simplImplOut) mb_simpl let prxs_a = MNil :>: (Proxy :: Proxy a) @@ -2149,34 +2158,34 @@ translateSimplImpl (ps0 :: Proxy ps0) mb_simpl m = case mbMatch mb_simpl of (_ :>: ptrans, _) = RL.split prxs_a prxs1 pctx2 in pctx1 :>: typeTransF ttrans (transTerms ptrans)) m - + [nuMP| SImpl_IntroEqRefl x |] -> withPermStackM (:>: translateVar x) (:>: PTrans_Eq (fmap PExpr_Var x)) m - + [nuMP| SImpl_InvertEq x y |] -> withPermStackM ((:>: translateVar y) . RL.tail) ((:>: PTrans_Eq (fmap PExpr_Var x)) . RL.tail) m - + [nuMP| SImpl_InvTransEq _ mb_y _ |] -> withPermStackM RL.tail ((:>: PTrans_Eq (fmap PExpr_Var mb_y)) . RL.tail . RL.tail) m - + [nuMP| SImpl_CopyEq _ _ |] -> withPermStackM (\(vars :>: var) -> (vars :>: var :>: var)) (\(pctx :>: ptrans) -> (pctx :>: ptrans :>: ptrans)) m - + [nuMP| SImpl_LLVMWordEq _ _ e |] -> withPermStackM RL.tail (\(pctx :>: _ :>: _) -> (pctx :>: PTrans_Eq (fmap PExpr_LLVMWord e))) m - + [nuMP| SImpl_IntroConj x |] -> withPermStackM (:>: translateVar x) (:>: PTrans_True) m - + [nuMP| SImpl_ExtractConj x _ mb_i |] -> withPermStackM (:>: translateVar x) (\(pctx :>: ptrans) -> @@ -2188,7 +2197,7 @@ translateSimplImpl (ps0 :: Proxy ps0) mb_simpl m = case mbMatch mb_simpl of else error "translateSimplImpl: SImpl_ExtractConj: index out of bounds") m - + [nuMP| SImpl_CopyConj x _ mb_i |] -> withPermStackM (:>: translateVar x) (\(pctx :>: ptrans) -> @@ -2197,7 +2206,7 @@ translateSimplImpl (ps0 :: Proxy ps0) mb_simpl m = case mbMatch mb_simpl of if i < length ps then pctx :>: PTrans_Conj [ps !! i] :>: ptrans else error "translateSimplImpl: SImpl_CopyConj: index out of bounds") m - + [nuMP| SImpl_InsertConj _ _ _ i |] -> withPermStackM RL.tail (\(pctx :>: ptransi :>: ptrans) -> @@ -2205,7 +2214,7 @@ translateSimplImpl (ps0 :: Proxy ps0) mb_simpl m = case mbMatch mb_simpl of pi = unPTransConj1 "translateSimplImpl: SImpl_InsertConj" ptransi in pctx :>: PTrans_Conj (take (mbLift i) ps ++ pi : drop (mbLift i) ps)) m - + [nuMP| SImpl_AppendConjs _ _ _ |] -> withPermStackM RL.tail (\(pctx :>: ptrans1 :>: ptrans2) -> @@ -2213,7 +2222,7 @@ translateSimplImpl (ps0 :: Proxy ps0) mb_simpl m = case mbMatch mb_simpl of ps2 = unPTransConj "translateSimplImpl: SImpl_AppendConjs" ptrans2 in pctx :>: PTrans_Conj (ps1 ++ ps2)) m - + [nuMP| SImpl_SplitConjs x _ mb_i |] -> let i = mbLift mb_i in withPermStackM (:>: translateVar x) @@ -2221,13 +2230,13 @@ translateSimplImpl (ps0 :: Proxy ps0) mb_simpl m = case mbMatch mb_simpl of let ps = unPTransConj "translateSimplImpl: SImpl_SplitConjs" ptrans in pctx :>: PTrans_Conj (take i ps) :>: PTrans_Conj (drop i ps)) m - + [nuMP| SImpl_IntroStructTrue x prxs |] -> withPermStackM (:>: translateVar x) (\pctx -> pctx :>: PTrans_Conj [APTrans_Struct $ RL.map (const PTrans_True) (mbRAssign prxs)]) m - + [nuMP| SImpl_StructEqToPerm _ exprs |] -> withPermStackM id (\(pctx :>: _) -> @@ -2235,19 +2244,19 @@ translateSimplImpl (ps0 :: Proxy ps0) mb_simpl m = case mbMatch mb_simpl of RL.map (PTrans_Eq . getCompose) (mbRAssign $ fmap exprsToRAssign exprs)]) m - + [nuMP| SImpl_StructPermToEq _ exprs |] -> withPermStackM id (\(pctx :>: _) -> pctx :>: PTrans_Eq (fmap PExpr_Struct exprs)) m - + [nuMP| SImpl_IntroStructField _ _ memb _ |] -> withPermStackM RL.tail (\(pctx :>: PTrans_Conj [APTrans_Struct pctx_str] :>: ptrans) -> pctx :>: PTrans_Conj [APTrans_Struct $ RL.set (mbLift memb) ptrans pctx_str]) m - + [nuMP| SImpl_ConstFunPerm x _ mb_fun_perm ident |] -> withPermStackM ((:>: translateVar x) . RL.tail) ((:>: PTrans_Term (fmap (ValPerm_Conj1 @@ -2255,37 +2264,37 @@ translateSimplImpl (ps0 :: Proxy ps0) mb_simpl m = case mbMatch mb_simpl of mbLift ident)) . RL.tail) m - + [nuMP| SImpl_CastLLVMWord _ _ e2 |] -> withPermStackM RL.tail ((:>: PTrans_Eq (fmap PExpr_LLVMWord e2)) . RL.tail . RL.tail) m - + [nuMP| SImpl_InvertLLVMOffsetEq mb_x mb_off mb_y |] -> withPermStackM ((:>: translateVar mb_y) . RL.tail) ((:>: PTrans_Eq (mbMap2 (\x off -> PExpr_LLVMOffset x $ bvNegate off) mb_x mb_off)) . RL.tail) m - + [nuMP| SImpl_OffsetLLVMWord _ mb_e mb_off mb_x |] -> withPermStackM ((:>: translateVar mb_x) . RL.tail . RL.tail) ((:>: PTrans_Eq (mbMap2 (\e off -> PExpr_LLVMWord $ bvAdd e off) mb_e mb_off)) . RL.tail . RL.tail) m - + [nuMP| SImpl_CastLLVMPtr _ _ off _ |] -> withPermStackM RL.tail (\(pctx :>: _ :>: ptrans) -> pctx :>: offsetLLVMPermTrans (fmap bvNegate off) ptrans) m - + [nuMP| SImpl_CastLLVMFree _ _ e2 |] -> withPermStackM RL.tail ((:>: PTrans_Conj [APTrans_LLVMFree e2]) . RL.tail . RL.tail) m - + [nuMP| SImpl_CastLLVMFieldOffset _ mb_fld mb_off |] -> withPermStackM RL.tail (\(pctx :>: _ :>: ptrans) -> @@ -2297,13 +2306,13 @@ translateSimplImpl (ps0 :: Proxy ps0) mb_simpl m = case mbMatch mb_simpl of mb_fld mb_off) ptrans']) m - + [nuMP| SImpl_IntroLLVMFieldContents x _ mb_fld |] -> withPermStackM ((:>: translateVar x) . RL.tail . RL.tail) (\(pctx :>: _ :>: ptrans) -> pctx :>: PTrans_Conj [APTrans_LLVMField mb_fld ptrans]) m - + [nuMP| SImpl_DemoteLLVMFieldRW _ mb_fld |] -> withPermStackM id (\(pctx :>: ptrans) -> @@ -2315,7 +2324,7 @@ translateSimplImpl (ps0 :: Proxy ps0) mb_simpl m = case mbMatch mb_simpl of (fmap (\fld -> fld { llvmFieldRW = PExpr_Read }) mb_fld) ptrans']) m - + [nuMP| SImpl_LLVMArrayCopy _ mb_ap mb_sub_ap |] -> do let _w = natVal2 mb_ap sub_ap_tp_trans <- translate mb_sub_ap @@ -2335,7 +2344,7 @@ translateSimplImpl (ps0 :: Proxy ps0) mb_simpl m = case mbMatch mb_simpl of rng_trans {- mb_sub_borrows -} prop_transs] :>: ptrans_array) m - + [nuMP| SImpl_LLVMArrayBorrow _ mb_ap mb_sub_ap |] -> do sub_ap_tp_trans <- translate mb_sub_ap let mb_rng = mbMap2 llvmSubArrayRange mb_ap mb_sub_ap @@ -2366,7 +2375,7 @@ translateSimplImpl (ps0 :: Proxy ps0) mb_simpl m = case mbMatch mb_simpl of PTrans_Conj [sub_array_trans] :>: PTrans_Conj [APTrans_LLVMArray array_trans']) m - + [nuMP| SImpl_LLVMArrayReturn _ mb_ap mb_ret_ap |] -> do (_ :>: ptrans_sub_array :>: ptrans_array) <- itiPermStack <$> ask let mb_cell = @@ -2392,7 +2401,7 @@ translateSimplImpl (ps0 :: Proxy ps0) mb_simpl m = case mbMatch mb_simpl of (\(pctx :>: _ :>: _) -> pctx :>: PTrans_Conj [APTrans_LLVMArray array_trans']) m - + [nuMP| SImpl_LLVMArrayAppend _ mb_ap1 mb_ap2 |] -> withPermStackM RL.tail (\(pctx :>: ptrans_array1 :>: ptrans_array2) -> @@ -2422,8 +2431,8 @@ translateSimplImpl (ps0 :: Proxy ps0) mb_simpl m = case mbMatch mb_simpl of llvmArrayTransTerm array_trans2] } in pctx :>: PTrans_Conj [APTrans_LLVMArray array_trans_out]) m - - + + [nuMP| SImpl_LLVMArrayRearrange _ _ mb_ap2 |] -> do ap2_tp_trans <- translate mb_ap2 withPermStackM id @@ -2432,13 +2441,13 @@ translateSimplImpl (ps0 :: Proxy ps0) mb_simpl m = case mbMatch mb_simpl of PTrans_Conj [APTrans_LLVMArray $ typeTransF ap2_tp_trans [transTerm1 ptrans_array]]) m - + [nuMP| SImpl_LLVMArrayToField _ _ _ |] -> do ttrans <- translate $ fmap (distPermsHeadPerm . simplImplOut) mb_simpl withPermStackM id (\(pctx :>: _) -> pctx :>: typeTransF ttrans []) m - + [nuMP| SImpl_LLVMArrayEmpty x mb_ap |] -> do (w_term, _, elem_tp, ap_tp_trans) <- translateLLVMArrayPerm mb_ap let arr_term = @@ -2449,7 +2458,7 @@ translateSimplImpl (ps0 :: Proxy ps0) mb_simpl m = case mbMatch mb_simpl of pctx :>: PTrans_Conj [APTrans_LLVMArray $ typeTransF ap_tp_trans [arr_term]]) m - + [nuMP| SImpl_LLVMArrayOneCell _ mb_ap |] -> do (w_term, len_term, elem_tp, ap_tp_trans) <- translateLLVMArrayPerm mb_ap withPermStackM id @@ -2460,8 +2469,8 @@ translateSimplImpl (ps0 :: Proxy ps0) mb_simpl m = case mbMatch mb_simpl of pctx :>: PTrans_Conj [APTrans_LLVMArray $ typeTransF ap_tp_trans [arr_term]]) m - - + + [nuMP| SImpl_LLVMArrayIndexCopy _ _ mb_ix |] -> do (_ :>: ptrans_array :>: ptrans_props) <- itiPermStack <$> ask let arr_trans = @@ -2476,7 +2485,7 @@ translateSimplImpl (ps0 :: Proxy ps0) mb_simpl m = case mbMatch mb_simpl of (\(pctx :>: _ :>: _) -> pctx :>: PTrans_Conj [fld_ptrans] :>: ptrans_array) m - + [nuMP| SImpl_LLVMArrayIndexBorrow _ mb_ap mb_ix |] -> do (_ :>: ptrans_array :>: ptrans_props) <- itiPermStack <$> ask let arr_trans = @@ -2498,7 +2507,7 @@ translateSimplImpl (ps0 :: Proxy ps0) mb_simpl m = case mbMatch mb_simpl of pctx :>: PTrans_Conj [fld_ptrans] :>: PTrans_Conj [APTrans_LLVMArray arr_trans']) m - + [nuMP| SImpl_LLVMArrayIndexReturn _ mb_ap mb_ix |] -> do (_ :>: ptrans_fld :>: ptrans_array) <- itiPermStack <$> ask let aptrans_fld = case ptrans_fld of @@ -2520,29 +2529,29 @@ translateSimplImpl (ps0 :: Proxy ps0) mb_simpl m = case mbMatch mb_simpl of (\(pctx :>: _ :>: _) -> pctx :>: PTrans_Conj [APTrans_LLVMArray arr_trans']) m - + [nuMP| SImpl_LLVMArrayContents _ _ _ _ _ |] -> error "FIXME HERE: translateSimplImpl: SImpl_LLVMArrayContents unhandled" - + [nuMP| SImpl_LLVMFieldIsPtr x _ |] -> withPermStackM (:>: translateVar x) (\(pctx :>: ptrans_fld) -> pctx :>: PTrans_Conj [APTrans_IsLLVMPtr] :>: ptrans_fld) m - + [nuMP| SImpl_LLVMArrayIsPtr x _ |] -> withPermStackM (:>: translateVar x) (\(pctx :>: ptrans_array) -> pctx :>: PTrans_Conj [APTrans_IsLLVMPtr] :>: ptrans_array) m - + [nuMP| SImpl_LLVMBlockIsPtr x _ |] -> withPermStackM (:>: translateVar x) (\(pctx :>: ptrans) -> pctx :>: PTrans_Conj [APTrans_IsLLVMPtr] :>: ptrans) m - - [nuMP| SImpl_SplitLifetime _ f args l _ ps_in ps_out |] -> + + [nuMP| SImpl_SplitLifetime _ f args l _ _ ps_in ps_out |] -> do pctx_out_trans <- translate $ fmap simplImplOut mb_simpl ps_in_tp <- translate1 ps_in ps_out_tp <- translate1 ps_out @@ -2565,30 +2574,36 @@ translateSimplImpl (ps0 :: Proxy ps0) mb_simpl m = case mbMatch mb_simpl of RL.append pctx $ typeTransF pctx_out_trans (transTerms ptrans_x ++ [f_tm])) m - - [nuMP| SImpl_SubsumeLifetime _ _ ps_in1 ps_out1 ps_in2 ps_out2 |] -> + + [nuMP| SImpl_SubsumeLifetime _ _ _ _ _ |] -> do pctx_out_trans <- translate $ fmap simplImplOut mb_simpl - ps_in1_tp <- translate1 ps_in1 - ps_out1_tp <- translate1 ps_out1 - ps_in2_tp <- translate1 ps_in2 - ps_out2_tp <- translate1 ps_out2 - let fun_tp1 = arrowOpenTerm "ps" ps_in1_tp (applyOpenTerm - (globalOpenTerm "Prelude.CompM") - ps_out1_tp) withPermStackM id - (\(pctx :>: ptrans_l1 :>: ptrans_l2) -> - -- The output permissions are an lcurrent permission, which has no term - -- translation, and the updated lowned permission, which is the result - -- of adding the translation of the lowned permission for l1 to the - -- return value of that for l2 - RL.append pctx $ - typeTransF pctx_out_trans [applyOpenTermMulti - (globalOpenTerm "Prelude.tupleCompMFunOut") - [ps_in2_tp, ps_out2_tp, fun_tp1, - transTerm1 ptrans_l1, - transTerm1 ptrans_l2]]) + (\(pctx :>: ptrans_l) -> + RL.append pctx $ typeTransF pctx_out_trans (transTerms ptrans_l)) + m + + [nuMP| SImpl_ContainedLifetimeCurrent _ _ _ _ _ |] -> + do pctx_out_trans <- translate $ fmap simplImplOut mb_simpl + withPermStackM + (\(ns :>: l1) -> ns :>: l1 :>: l1) + (\(pctx :>: ptrans_l) -> + -- Note: lcurrent perms do not contain any terms and the term for the + -- lowned permission does not change, so the only terms in both the + -- input and the output are in ptrans_l + RL.append pctx $ typeTransF pctx_out_trans (transTerms ptrans_l)) m - + + [nuMP| SImpl_RemoveContainedLifetime _ _ _ _ _ |] -> + do pctx_out_trans <- translate $ fmap simplImplOut mb_simpl + withPermStackM + (\(ns :>: l1 :>: _) -> ns :>: l1) + (\(pctx :>: ptrans_l :>: _) -> + -- Note: lcurrent perms do not contain any terms and the term for the + -- lowned permission does not change, so the only terms in both the + -- input and the output are in ptrans_l + RL.append pctx $ typeTransF pctx_out_trans (transTerms ptrans_l)) + m + [nuMP| SImpl_WeakenLifetime _ _ _ _ _ |] -> do pctx_out_trans <- translate $ fmap simplImplOut mb_simpl withPermStackM RL.tail @@ -2598,9 +2613,9 @@ translateSimplImpl (ps0 :: Proxy ps0) mb_simpl m = case mbMatch mb_simpl of -- ptrans_x to pctx_out_trans RL.append pctx (typeTransF pctx_out_trans $ transTerms ptrans_x)) m - - [nuMP| SImpl_MapLifetime l ps_in ps_out - ps_in' ps_out' ps1 ps2 impl_in impl_out |] -> + + [nuMP| SImpl_MapLifetime l _ ps_in ps_out + ps_in' ps_out' ps1 ps2 impl_in impl_out |] -> -- First, translate the output permissions and all of the perm lists do pctx_out_trans <- translate $ fmap simplImplOut mb_simpl ps_in_trans <- translate ps_in @@ -2609,7 +2624,7 @@ translateSimplImpl (ps0 :: Proxy ps0) mb_simpl m = case mbMatch mb_simpl of ps_out'_trans <- translate ps_out' -- ps1_trans <- translate ps1 -- ps2_trans <- translate ps2 - + -- Next, split out the various input permissions from the rest of the pctx let prxs1 = mbRAssignProxies ps1 let prxs2 = mbRAssignProxies ps2 @@ -2617,13 +2632,13 @@ translateSimplImpl (ps0 :: Proxy ps0) mb_simpl m = case mbMatch mb_simpl of pctx <- itiPermStack <$> ask let (pctx_ps, pctx12 :>: ptrans_l) = RL.split ps0 prxs_in pctx let (pctx1, pctx2) = RL.split prxs1 prxs2 pctx12 - + -- Also split out the input variables and replace them with the ps_out vars pctx_vars <- itiPermStackVars <$> ask let (vars_ps, vars12 :>: _) = RL.split ps0 prxs_in pctx_vars let (vars1, vars2) = RL.split prxs1 prxs2 vars12 let vars_out = vars_ps :>: translateVar l - + -- Now build the output lowned function by composing the input lowned -- function with the translations of the implications on inputs and outputs let fromJustOrError (Just x) = x @@ -2649,23 +2664,23 @@ translateSimplImpl (ps0 :: Proxy ps0) mb_simpl m = case mbMatch mb_simpl of (globalOpenTerm "Prelude.composeM") [transTerm1 ps_in_trans, transTerm1 ps_out_trans, transTerm1 ps_out'_trans, transTerm1 ptrans_l, impl_out_tm]] - + -- Finally, update the permissions withPermStackM (\_ -> vars_out) (\_ -> RL.append pctx_ps $ typeTransF pctx_out_trans [l_res_tm]) m - + [nuMP| SImpl_EndLifetime _ ps_in ps_out |] -> -- First, translate the output permissions and the input and output types of -- the monadic function for the lifeime ownership permission do ps_out_trans <- translate ps_out let prxs_in = mbRAssignProxies ps_in :>: Proxy - + -- Next, split out the ps_in permissions from the rest of the pctx pctx <- itiPermStack <$> ask let (pctx_ps, pctx_in :>: ptrans_l) = RL.split ps0 prxs_in pctx - + -- Also split out the ps_in variables and replace them with the ps_out vars pctx_vars <- itiPermStackVars <$> ask let (ps_vars, _ :>: _) = RL.split ps0 prxs_in pctx_vars @@ -2674,7 +2689,7 @@ translateSimplImpl (ps0 :: Proxy ps0) mb_simpl m = case mbMatch mb_simpl of let vars_out = RL.append ps_vars $ RL.map (translateVar . getCompose) $ mbRAssign $ fmap (fromJustHelper . lownedPermsVars) ps_out - + -- Now we apply the lifetime ownerhip function to ps_in and bind its output -- in the rest of the computation applyMultiTransM (return $ globalOpenTerm "Prelude.bindM") @@ -2683,39 +2698,40 @@ translateSimplImpl (ps0 :: Proxy ps0) mb_simpl m = case mbMatch mb_simpl of (strictTransTupleTerm pctx_in)), lambdaTransM "endl_ps" ps_out_trans $ \pctx_out -> withPermStackM - (\_ -> vars_out) - (\_ -> RL.append pctx_ps pctx_out) + (\(_ :>: l) -> vars_out :>: l) + (\_ -> RL.append pctx_ps pctx_out :>: + PTrans_Conj [APTrans_LFinished]) m] - + [nuMP| SImpl_LCurrentRefl l |] -> withPermStackM (:>: translateVar l) (:>: PTrans_Conj [APTrans_LCurrent $ fmap PExpr_Var l]) m - + [nuMP| SImpl_LCurrentTrans _l1 _l2 l3 |] -> withPermStackM RL.tail ((:>: PTrans_Conj [APTrans_LCurrent l3]) . RL.tail . RL.tail) m - + [nuMP| SImpl_DemoteLLVMBlockRW _ _ |] -> do ttrans <- translate $ fmap (distPermsHeadPerm . simplImplOut) mb_simpl withPermStackM id (\(pctx :>: ptrans) -> pctx :>: typeTransF ttrans (transTerms ptrans)) m - + [nuMP| SImpl_IntroLLVMBlockEmpty x _ |] -> do ttrans <- translate $ fmap (distPermsHeadPerm . simplImplOut) mb_simpl withPermStackM (:>: translateVar x) (\pctx -> pctx :>: typeTransF ttrans [unitOpenTerm]) m - + [nuMP| SImpl_CoerceLLVMBlockEmpty _ _ |] -> do ttrans <- translate $ fmap (distPermsHeadPerm . simplImplOut) mb_simpl withPermStackM id (\(pctx :>: _) -> pctx :>: typeTransF ttrans [unitOpenTerm]) m - + [nuMP| SImpl_ElimLLVMBlockToBytes _ mb_bp |] -> do let w = natVal2 mb_bp let w_term = natOpenTerm w @@ -2728,7 +2744,7 @@ translateSimplImpl (ps0 :: Proxy ps0) mb_simpl m = case mbMatch mb_simpl of [w_term, len_term, unitTypeOpenTerm, unitOpenTerm] in pctx :>: typeTransF ttrans [arr_term]) m - + [nuMP| SImpl_IntroLLVMBlockSeqEmpty _ _ |] -> do ttrans <- translate $ fmap (distPermsHeadPerm . simplImplOut) mb_simpl withPermStackM id @@ -2736,14 +2752,14 @@ translateSimplImpl (ps0 :: Proxy ps0) mb_simpl m = case mbMatch mb_simpl of pctx :>: typeTransF ttrans [pairOpenTerm (transTerm1 ptrans) unitOpenTerm]) m - + [nuMP| SImpl_ElimLLVMBlockSeqEmpty _ _ |] -> do ttrans <- translate $ fmap (distPermsHeadPerm . simplImplOut) mb_simpl withPermStackM id (\(pctx :>: ptrans) -> pctx :>: typeTransF ttrans [pairLeftOpenTerm (transTerm1 ptrans)]) m - + -- Intro for a recursive named shape applies the fold function to the -- translations of the arguments plus the translations of the proofs of the -- permissions @@ -2803,35 +2819,35 @@ translateSimplImpl (ps0 :: Proxy ps0) mb_simpl m = case mbMatch mb_simpl of m | otherwise -> fail "translateSimplImpl: ElimLLVMBlockNamed, unknown named shape" - + [nuMP| SImpl_IntroLLVMBlockFromEq _ _ _ |] -> do ttrans <- translate $ fmap (distPermsHeadPerm . simplImplOut) mb_simpl withPermStackM RL.tail (\(pctx :>: _ :>: ptrans) -> pctx :>: typeTransF ttrans [transTerm1 ptrans]) m - + [nuMP| SImpl_IntroLLVMBlockPtr _ _ _ _ |] -> do ttrans <- translate $ fmap (distPermsHeadPerm . simplImplOut) mb_simpl withPermStackM id (\(pctx :>: ptrans) -> pctx :>: typeTransF ttrans (transTerms ptrans)) m - + [nuMP| SImpl_ElimLLVMBlockPtr _ _ _ _ |] -> do ttrans <- translate $ fmap (distPermsHeadPerm . simplImplOut) mb_simpl withPermStackM id (\(pctx :>: ptrans) -> pctx :>: typeTransF ttrans (transTerms ptrans)) m - + [nuMP| SImpl_IntroLLVMBlockField _ _ |] -> do ttrans <- translate $ fmap (distPermsHeadPerm . simplImplOut) mb_simpl withPermStackM id (\(pctx :>: ptrans) -> pctx :>: typeTransF ttrans [transTupleTerm ptrans]) m - + [nuMP| SImpl_ElimLLVMBlockField _ _ _ |] -> do let mb_ps = fmap ((\case ValPerm_Conj ps -> ps _ -> error "translateSimplImpl: SImpl_ElimLLVMBlockField, VPerm_Conj required" @@ -2844,21 +2860,21 @@ translateSimplImpl (ps0 :: Proxy ps0) mb_simpl m = case mbMatch mb_simpl of PTrans_Conj [typeTransF (tupleTypeTrans ttrans1) [transTerm1 ptrans], typeTransF ttrans2 [unitOpenTerm]]) m - + [nuMP| SImpl_IntroLLVMBlockArray _ _ |] -> do ttrans <- translate $ fmap (distPermsHeadPerm . simplImplOut) mb_simpl withPermStackM id (\(pctx :>: ptrans) -> pctx :>: typeTransF ttrans [transTerm1 ptrans]) m - + [nuMP| SImpl_ElimLLVMBlockArray _ _ |] -> do ttrans <- translate $ fmap (distPermsHeadPerm . simplImplOut) mb_simpl withPermStackM id (\(pctx :>: ptrans) -> pctx :>: typeTransF ttrans [transTerm1 ptrans]) m - + [nuMP| SImpl_IntroLLVMBlockSeq _ _ _ _ |] -> do ttrans <- translate $ fmap (distPermsHeadPerm . simplImplOut) mb_simpl withPermStackM RL.tail @@ -2867,7 +2883,7 @@ translateSimplImpl (ps0 :: Proxy ps0) mb_simpl m = case mbMatch mb_simpl of pairOpenTerm (transTerm1 ptrans1) (transTerm1 ptrans2) in pctx :>: typeTransF ttrans [pair_term]) m - + [nuMP| SImpl_ElimLLVMBlockSeq _ _ _ |] -> do ttrans <- translate $ fmap (distPermsHeadPerm . simplImplOut) mb_simpl withPermStackM id @@ -2875,31 +2891,31 @@ translateSimplImpl (ps0 :: Proxy ps0) mb_simpl m = case mbMatch mb_simpl of pctx :>: typeTransF ttrans [pairLeftOpenTerm (transTerm1 ptrans), pairRightOpenTerm (transTerm1 ptrans)]) m - + [nuMP| SImpl_IntroLLVMBlockOr _ _ _ |] -> do ttrans <- translate $ fmap (distPermsHeadPerm . simplImplOut) mb_simpl withPermStackM id (\(pctx :>: ptrans) -> pctx :>: typeTransF ttrans [transTerm1 ptrans]) m - + [nuMP| SImpl_ElimLLVMBlockOr _ _ _ |] -> do ttrans <- translate $ fmap (distPermsHeadPerm . simplImplOut) mb_simpl withPermStackM id (\(pctx :>: ptrans) -> pctx :>: typeTransF ttrans [transTerm1 ptrans]) m - + [nuMP| SImpl_IntroLLVMBlockEx _ _ |] -> do ttrans <- translate $ fmap (distPermsHeadPerm . simplImplOut) mb_simpl withPermStackM id (\(pctx :>: ptrans) -> pctx :>: typeTransF ttrans [transTerm1 ptrans]) m - + [nuMP| SImpl_ElimLLVMBlockEx _ _ |] -> do ttrans <- translate $ fmap (distPermsHeadPerm . simplImplOut) mb_simpl withPermStackM id (\(pctx :>: ptrans) -> pctx :>: typeTransF ttrans [transTerm1 ptrans]) m - + [nuMP| SImpl_FoldNamed _ (NamedPerm_Rec rp) args _ |] -> do args_trans <- translate args ttrans <- translate $ fmap (distPermsHeadPerm . simplImplOut) mb_simpl @@ -2911,7 +2927,7 @@ translateSimplImpl (ps0 :: Proxy ps0) mb_simpl m = case mbMatch mb_simpl of (transTerms args_trans ++ transTerms ptrans_x)]) m - + [nuMP| SImpl_UnfoldNamed _ (NamedPerm_Rec rp) args _ |] -> do args_trans <- translate args ttrans <- translate $ fmap (distPermsHeadPerm . simplImplOut) mb_simpl @@ -2924,7 +2940,7 @@ translateSimplImpl (ps0 :: Proxy ps0) mb_simpl m = case mbMatch mb_simpl of (transTerms args_trans ++ [transTerm1 ptrans_x])]) m - + [nuMP| SImpl_FoldNamed _ (NamedPerm_Defined dp) args off |] -> do folded_trans <- translate (mbMap2 ValPerm_Named (fmap definedPermName dp) args @@ -2933,7 +2949,7 @@ translateSimplImpl (ps0 :: Proxy ps0) mb_simpl m = case mbMatch mb_simpl of (\(pctx :>: ptrans) -> pctx :>: typeTransF folded_trans (transTerms ptrans)) m - + [nuMP| SImpl_UnfoldNamed _ (NamedPerm_Defined dp) args off |] -> do unfolded_trans <- translate (mbMap2 unfoldDefinedPerm dp args `mbApply` off) @@ -2941,48 +2957,48 @@ translateSimplImpl (ps0 :: Proxy ps0) mb_simpl m = case mbMatch mb_simpl of (\(pctx :>: ptrans) -> pctx :>: typeTransF unfolded_trans (transTerms ptrans)) m - + {- [nuMP| SImpl_Mu _ _ _ _ |] -> error "FIXME HERE: SImpl_Mu: translation not yet implemented" -} - + [nuMP| SImpl_NamedToConj _ _ _ _ |] -> do tp_trans <- translate $ fmap (distPermsHeadPerm . simplImplOut) mb_simpl withPermStackM id (\(pctx :>: ptrans) -> pctx :>: typeTransF tp_trans (transTerms ptrans)) m - + [nuMP| SImpl_NamedFromConj _ _ _ _ |] -> do tp_trans <- translate $ fmap (distPermsHeadPerm . simplImplOut) mb_simpl withPermStackM id (\(pctx :>: ptrans) -> pctx :>: typeTransF tp_trans (transTerms ptrans)) m - + [nuMP| SImpl_NamedArgAlways _ _ _ _ _ _ |] -> do tp_trans <- translate $ fmap (distPermsHeadPerm . simplImplOut) mb_simpl withPermStackM id (\(pctx :>: ptrans) -> pctx :>: typeTransF tp_trans (transTerms ptrans)) m - + [nuMP| SImpl_NamedArgCurrent _ _ _ _ _ _ |] -> do tp_trans <- translate $ fmap (distPermsHeadPerm . simplImplOut) mb_simpl withPermStackM RL.tail (\(pctx :>: ptrans :>: _) -> pctx :>: typeTransF tp_trans (transTerms ptrans)) m - + [nuMP| SImpl_NamedArgWrite _ _ _ _ _ _ |] -> do tp_trans <- translate $ fmap (distPermsHeadPerm . simplImplOut) mb_simpl withPermStackM id (\(pctx :>: ptrans) -> pctx :>: typeTransF tp_trans (transTerms ptrans)) m - + [nuMP| SImpl_NamedArgRead _ _ _ _ _ |] -> do tp_trans <- translate $ fmap (distPermsHeadPerm . simplImplOut) mb_simpl withPermStackM id (\(pctx :>: ptrans) -> pctx :>: typeTransF tp_trans (transTerms ptrans)) m - + [nuMP| SImpl_ReachabilityTrans _ rp args _ y e |] -> do args_trans <- translate $ mbMap2 PExprs_Cons args e y_trans <- translate y @@ -3081,7 +3097,7 @@ translatePermImpl1 prx mb_impl mb_impls = case (mbMatch mb_impl, mbMatch mb_impl -- Impl1_Catch, if one exists, or the SAW errorM function otherwise ([nuMP| Impl1_Fail str |], _) -> tell [mbLift str] >> mzero - + ([nuMP| Impl1_Catch |], [nuMP| (MbPermImpls_Cons _ (MbPermImpls_Cons _ _ mb_impl1) mb_impl2) |]) -> pitmCatching (translatePermImpl prx $ mbCombine RL.typeCtxProxies mb_impl1) >>= \maybe_trans1 -> @@ -3094,7 +3110,7 @@ translatePermImpl1 prx mb_impl mb_impls = case (mbMatch mb_impl, mbMatch mb_impl (\catchpoint -> trans1 $ ImplFailContTerm catchpoint) (Nothing, Just trans2) -> return trans2 (_, Nothing) -> pitmMaybeRet maybe_trans1 - + -- A push moves the given permission from x to the top of the perm stack ([nuMP| Impl1_Push x p |], _) -> translatePermImplUnary mb_impls $ \m -> @@ -3102,7 +3118,7 @@ translatePermImpl1 prx mb_impl mb_impls = case (mbMatch mb_impl, mbMatch mb_impl ptrans <- getVarPermM x setVarPermM x (PTrans_True) (withPermStackM (:>: translateVar x) (:>: ptrans) m) - + -- A pop moves the given permission from the top of the perm stack to x ([nuMP| Impl1_Pop x p |], _) -> translatePermImplUnary mb_impls $ \m -> @@ -3111,7 +3127,7 @@ translatePermImpl1 prx mb_impl mb_impls = case (mbMatch mb_impl, mbMatch mb_impl const ValPerm_True) ptrans <- getTopPermM setVarPermM x ptrans (withPermStackM RL.tail RL.tail m) - + -- If both branches of an or elimination fail, the whole thing fails; otherwise, -- an or elimination performs a pattern-match on an Either ([nuMP| Impl1_ElimOr x p1 p2 |], @@ -3135,7 +3151,7 @@ translatePermImpl1 prx mb_impl mb_impls = case (mbMatch mb_impl, mbMatch mb_impl withPermStackM id ((:>: ptrans) . RL.tail) $ forceImplTrans maybe_trans2 k) (transTupleTerm top_ptrans) - + -- An existential elimination performs a pattern-match on a Sigma ([nuMP| Impl1_ElimExists x p |], _) -> translatePermImplUnary mb_impls $ \m -> @@ -3150,7 +3166,7 @@ translatePermImpl1 prx mb_impl mb_impls = case (mbMatch mb_impl, mbMatch mb_impl inExtTransM etrans $ withPermStackM id ((:>: ptrans) . RL.tail) m) (transTerm1 top_ptrans) - + -- A SimplImpl is translated using translateSimplImpl ([nuMP| Impl1_Simpl simpl mb_prx |], _) -> let prx' = mbLift mb_prx in @@ -3159,14 +3175,14 @@ translatePermImpl1 prx mb_impl mb_impls = case (mbMatch mb_impl, mbMatch mb_impl translateSimplImpl prx' simpl $ do () <- assertPermStackTopEqM "SimplImpl out" prx' (fmap simplImplOut simpl) m - + -- A let binding becomes a let binding ([nuMP| Impl1_LetBind _ e |], _) -> translatePermImplUnary mb_impls $ \m -> do etrans <- translate e inExtTransM etrans $ withPermStackM (:>: Member_Base) (:>: PTrans_Eq (extMb e)) m - + ([nuMP| Impl1_ElimStructField x _ _ memb |], _) -> translatePermImplUnary mb_impls $ \m -> do etrans_x <- translate x @@ -3181,7 +3197,7 @@ translatePermImpl1 prx mb_impl mb_impls = case (mbMatch mb_impl, mbMatch mb_impl RL.set (mbLift memb) (PTrans_Eq mb_y) pctx_str] :>: RL.get (mbLift memb) pctx_str) m - + ([nuMP| Impl1_ElimLLVMFieldContents _ mb_fld |], _) -> translatePermImplUnary mb_impls $ \m -> inExtTransM ETrans_LLVM $ @@ -3200,7 +3216,7 @@ translatePermImpl1 prx mb_impl mb_impls = case (mbMatch mb_impl, mbMatch mb_impl fmap (const $ nu PExpr_Var) mb_fld)] :>: ptrans') m - + ([nuMP| Impl1_ElimLLVMBlockToEq _ mb_bp |], _) -> translatePermImplUnary mb_impls $ \m -> inExtTransM ETrans_LLVMBlock $ @@ -3218,17 +3234,17 @@ translatePermImpl1 prx mb_impl mb_impls = case (mbMatch mb_impl, mbMatch mb_impl pctx :>: typeTransF tp_trans1 [unitOpenTerm] :>: typeTransF tp_trans2 [transTerm1 ptrans]) m - + ([nuMP| Impl1_BeginLifetime |], _) -> translatePermImplUnary mb_impls $ \m -> inExtTransM ETrans_Lifetime $ - do tp_trans <- translateClosed $ ValPerm_LOwned MNil MNil + do tp_trans <- translateClosed $ ValPerm_LOwned [] MNil MNil let id_fun = lambdaOpenTerm "ps_empty" unitTypeOpenTerm $ \x -> applyOpenTermMulti (globalOpenTerm "Prelude.returnM") [unitTypeOpenTerm, x] withPermStackM (:>: Member_Base) (:>: typeTransF tp_trans [id_fun]) m - + -- If e1 and e2 are already equal, short-circuit the proof construction and then -- elimination ([nuMP| Impl1_TryProveBVProp x prop@(BVProp_Eq e1 e2) _ |], _) @@ -3240,12 +3256,12 @@ translatePermImpl1 prx mb_impl mb_impls = case (mbMatch mb_impl, mbMatch mb_impl withPermStackM (:>: translateVar x) (:>: PTrans_Conj [APTrans_BVProp (BVPropTrans prop pf)]) m - + -- If e1 and e2 are definitely not equal, treat this as a fail ([nuMP| Impl1_TryProveBVProp _ (BVProp_Eq e1 e2) prop_str |], _) | not $ mbLift (mbMap2 bvCouldEqual e1 e2) -> tell [mbLift prop_str] >> mzero - + -- Otherwise, insert an equality test with proof construction. Note that, as -- with all TryProveBVProps, if the test fails and there is no failure -- continuation, we insert just the proposition failure string using @@ -3265,7 +3281,7 @@ translatePermImpl1 prx mb_impl mb_impls = case (mbMatch mb_impl, mbMatch mb_impl trans k) , applyMultiTransM (return $ globalOpenTerm "Prelude.bvEqWithProof") [ return (natOpenTerm $ natVal2 prop) , translate1 e1, translate1 e2]] - + -- For an inequality test, we don't need a proof, so just insert an if ([nuMP| Impl1_TryProveBVProp x prop@(BVProp_Neq e1 e2) prop_str |], [nuMP| MbPermImpls_Cons _ _ mb_impl' |]) -> @@ -3280,7 +3296,7 @@ translatePermImpl1 prx mb_impl mb_impls = case (mbMatch mb_impl, mbMatch mb_impl , withPermStackM (:>: translateVar x) (:>: PTrans_Conj [APTrans_BVProp (BVPropTrans prop unitOpenTerm)]) $ trans k] - + {- ([nuMP| Impl1_TryProveBVProp x prop@(BVProp_ULt e1 e2) _ |], [nuMP| MbPermImpls_Cons _ mb_impl' |]) @@ -3291,7 +3307,7 @@ translatePermImpl1 prx mb_impl mb_impls = case (mbMatch mb_impl, mbMatch mb_impl globalOpenTerm "Prelude.True"]))) (translate $ mbCombine mb_impl') -} - + ([nuMP| Impl1_TryProveBVProp x prop@(BVProp_ULt e1 e2) prop_str |], [nuMP| MbPermImpls_Cons _ _ mb_impl' |]) -> translatePermImpl prx (mbCombine RL.typeCtxProxies mb_impl') >>= \trans -> @@ -3307,7 +3323,7 @@ translatePermImpl1 prx mb_impl mb_impls = case (mbMatch mb_impl, mbMatch mb_impl , applyMultiTransM (return $ globalOpenTerm "Prelude.bvultWithProof") [ return (natOpenTerm $ natVal2 prop), translate1 e1, translate1 e2] ] - + {- ([nuMP| Impl1_TryProveBVProp x prop@(BVProp_ULeq e1 e2) _ |], [nuMP| MbPermImpls_Cons _ mb_impl' |]) @@ -3318,7 +3334,7 @@ translatePermImpl1 prx mb_impl mb_impls = case (mbMatch mb_impl, mbMatch mb_impl globalOpenTerm "Prelude.True"]))) (translate $ mbCombine mb_impl') -} - + ([nuMP| Impl1_TryProveBVProp x prop@(BVProp_ULeq e1 e2) prop_str |], [nuMP| MbPermImpls_Cons _ _ mb_impl' |]) -> translatePermImpl prx (mbCombine RL.typeCtxProxies mb_impl') >>= \trans -> @@ -3334,8 +3350,8 @@ translatePermImpl1 prx mb_impl mb_impls = case (mbMatch mb_impl, mbMatch mb_impl , applyMultiTransM (return $ globalOpenTerm "Prelude.bvuleWithProof") [ return (natOpenTerm $ natVal2 prop), translate1 e1, translate1 e2] ] - - + + ([nuMP| Impl1_TryProveBVProp x prop@(BVProp_ULeq_Diff e1 e2 e3) prop_str |], [nuMP| MbPermImpls_Cons _ _ mb_impl' |]) -> translatePermImpl prx (mbCombine RL.typeCtxProxies mb_impl') >>= \trans -> @@ -3461,9 +3477,9 @@ instance (PermCheckExtC ext, TransInfo info) => ETrans_Term <$> applyMultiTransM (return $ globalOpenTerm "Prelude.bvEq") [translate w, translateRWV e1, translateRWV e2] - + [nuMP| EmptyApp |] -> return ETrans_Unit - + -- Booleans [nuMP| BoolLit True |] -> return $ ETrans_Term $ globalOpenTerm "Prelude.True" @@ -3485,7 +3501,7 @@ instance (PermCheckExtC ext, TransInfo info) => ETrans_Term <$> applyMultiTransM (return $ globalOpenTerm "Prelude.xor") [translateRWV e1, translateRWV e2] - + -- Natural numbers [nuMP| Expr.NatLit n |] -> return $ ETrans_Term $ natOpenTerm $ mbLift n @@ -3518,11 +3534,11 @@ instance (PermCheckExtC ext, TransInfo info) => ETrans_Term <$> applyMultiTransM (return $ globalOpenTerm "Prelude.modNat") [translateRWV e1, translateRWV e2] - + -- Function handles: the expression part of a function handle has no -- computational content [nuMP| HandleLit _ |] -> return ETrans_Fun - + -- Bitvectors [nuMP| BVLit w mb_bv |] -> return $ ETrans_Term $ bvLitOpenTerm (mbLift w) $ mbLift mb_bv @@ -3659,12 +3675,12 @@ instance (PermCheckExtC ext, TransInfo info) => (applyMultiTransM (return $ globalOpenTerm "Prelude.bvEq") [translate mb_w, translateRWV e, return (bvLitOpenTerm w (BV.zero w))]) - + -- Strings [nuMP| Expr.StringLit (UnicodeLiteral text) |] -> return $ ETrans_Term $ stringLitOpenTerm $ mbLift text - + -- Everything else is an error _ -> error ("Unhandled expression form: " ++ @@ -3799,12 +3815,12 @@ translateStmt loc mb_stmt m = case mbMatch mb_stmt of let ptrans = exprOutPerm e inExtTransM etrans $ withPermStackM (:>: Member_Base) (:>: extPermTrans ptrans) m - + [nuMP| TypedSetRegPermExpr _ e |] -> do etrans <- tpTransM $ translate e inExtTransM etrans $ withPermStackM (:>: Member_Base) (:>: PTrans_Eq (extMb e)) m - + [nuMP| stmt@(TypedCall _freg fun_perm _ gexprs args) |] -> do f_trans <- getTopPermM let f = case f_trans of @@ -3839,14 +3855,14 @@ translateStmt loc mb_stmt m = case mbMatch mb_stmt of (const pctx) m) ret_val] - + -- FIXME HERE: figure out why these asserts always translate to ite True [nuMP| TypedAssert e _ |] -> applyMultiTransM (return $ globalOpenTerm "Prelude.ite") [compReturnTypeM, translate1 e, m, mkErrorCompM ("Failed Assert at " ++ renderDoc (ppShortFileName (plSourceLoc loc)))] - + [nuMP| TypedLLVMStmt stmt |] -> translateLLVMStmt stmt m @@ -3860,31 +3876,31 @@ translateLLVMStmt mb_stmt m = case mbMatch mb_stmt of inExtTransM ETrans_LLVM $ withPermStackM (:>: Member_Base) (:>: (PTrans_Eq $ extMb $ fmap (PExpr_LLVMWord . PExpr_Var) x)) m - + [nuMP| AssertLLVMWord reg _ |] -> inExtTransM (ETrans_Term $ natOpenTerm 0) $ withPermStackM ((:>: Member_Base) . RL.tail) ((:>: (PTrans_Eq $ fmap (const $ PExpr_Nat 0) $ extMb reg)) . RL.tail) m - + [nuMP| AssertLLVMPtr _ |] -> inExtTransM ETrans_Unit $ withPermStackM RL.tail RL.tail m - + [nuMP| DestructLLVMWord _ e |] -> translate e >>= \etrans -> inExtTransM etrans $ withPermStackM ((:>: Member_Base) . RL.tail) ((:>: (PTrans_Eq $ extMb e)) . RL.tail) m - + [nuMP| OffsetLLVMValue x off |] -> inExtTransM ETrans_LLVM $ withPermStackM (:>: Member_Base) (:>: (PTrans_Eq $ extMb $ mbMap2 PExpr_LLVMOffset (fmap typedRegVar x) off)) m - + [nuMP| TypedLLVMLoad _ (mb_fp :: LLVMFieldPerm w sz) (_ :: DistPerms ps) cur_perms |] -> let prx_l = mbLifetimeCurrentPermsProxies cur_perms @@ -3908,7 +3924,7 @@ translateLLVMStmt mb_stmt m = case mbMatch mb_stmt of fmap (const $ nu $ \ret -> PExpr_Var ret) mb_fp)] :>: p_ret) pctx_l) m - + [nuMP| TypedLLVMStore _ (mb_fp :: LLVMFieldPerm w sz) mb_e (_ :: DistPerms ps) cur_perms |] -> let prx_l = mbLifetimeCurrentPermsProxies cur_perms @@ -3926,7 +3942,7 @@ translateLLVMStmt mb_stmt m = case mbMatch mb_stmt of (PTrans_Eq $ extMb mb_e)]) pctx_l) m - + [nuMP| TypedLLVMAlloca _ (mb_fperm :: LLVMFramePerm w) mb_sz |] -> let sz = mbLift mb_sz w :: Proxy w = Proxy in @@ -3941,18 +3957,18 @@ translateLLVMStmt mb_stmt m = case mbMatch mb_stmt of \(_ :>: ret) fperm -> (PExpr_Var ret, sz):fperm] :>: typeTransF ptrans_tp []) m - + [nuMP| TypedLLVMCreateFrame |] -> withKnownNat ?ptrWidth $ inExtTransM ETrans_LLVMFrame $ withPermStackM (:>: Member_Base) (:>: PTrans_Conj [APTrans_LLVMFrame $ fmap (const []) (extMb mb_stmt)]) m - + [nuMP| TypedLLVMDeleteFrame _ _ _ |] -> inExtTransM ETrans_Unit $ withPermStackM (const MNil) (const MNil) m - + [nuMP| TypedLLVMLoadHandle _ tp _ |] -> inExtTransM ETrans_Fun $ withPermStackM ((:>: Member_Base) . RL.tail) @@ -3962,7 +3978,7 @@ translateLLVMStmt mb_stmt m = case mbMatch mb_stmt of _ -> error ("translateLLVMStmt: TypedLLVMLoadHandle: " ++ "unexpected function permission type")) m - + [nuMP| TypedLLVMResolveGlobal gsym (p :: ValuePerm (LLVMPointerType w))|] -> withKnownNat ?ptrWidth $ inExtTransM ETrans_LLVM $ @@ -3975,7 +3991,7 @@ translateLLVMStmt mb_stmt m = case mbMatch mb_stmt of ++ globalSymbolName (mbLift gsym)) Just (_, ts) -> withPermStackM (:>: Member_Base) (:>: typeTransF ptrans ts) m - + [nuMP| TypedLLVMIte _ mb_r1 _ _ |] -> inExtTransM ETrans_LLVM $ do b <- translate1 $ extMb mb_r1 From 13123747ccd79a9a020510429768eb02236c8a1f Mon Sep 17 00:00:00 2001 From: Eddy Westbrook Date: Fri, 6 Aug 2021 14:07:16 -0700 Subject: [PATCH 18/28] updated the remaining Heapster files to reflect the new form of the lowned permission --- heapster-saw/src/Verifier/SAW/Heapster/IRTTranslation.hs | 9 ++++++--- heapster-saw/src/Verifier/SAW/Heapster/RustTypes.hs | 4 ++-- heapster-saw/src/Verifier/SAW/Heapster/TypeChecker.hs | 2 +- 3 files changed, 9 insertions(+), 6 deletions(-) diff --git a/heapster-saw/src/Verifier/SAW/Heapster/IRTTranslation.hs b/heapster-saw/src/Verifier/SAW/Heapster/IRTTranslation.hs index bf67bae7dd..e35364f76e 100644 --- a/heapster-saw/src/Verifier/SAW/Heapster/IRTTranslation.hs +++ b/heapster-saw/src/Verifier/SAW/Heapster/IRTTranslation.hs @@ -154,8 +154,9 @@ instance ContainsIRTRecName (AtomicPerm a) where containsIRTRecName n (Perm_NamedConj _ args _) = containsIRTRecName n args containsIRTRecName n (Perm_LLVMFrame fperm) = containsIRTRecName n (map fst fperm) - containsIRTRecName _ (Perm_LOwned _ _) = False + containsIRTRecName _ (Perm_LOwned _ _ _) = False containsIRTRecName _ (Perm_LCurrent _) = False + containsIRTRecName _ Perm_LFinished = False containsIRTRecName n (Perm_Struct ps) = containsIRTRecName n ps containsIRTRecName _ (Perm_Fun _) = False containsIRTRecName _ (Perm_BVProp _) = False @@ -414,9 +415,10 @@ instance IRTTyVars (AtomicPerm a) where [nuMP| Perm_NamedConj npn args off |] -> namedPermIRTTyVars mb_p npn args off [nuMP| Perm_LLVMFrame _ |] -> return ([], IRTVarsNil) - [nuMP| Perm_LOwned _ _ |] -> + [nuMP| Perm_LOwned _ _ _ |] -> throwError "lowned permission in an IRT definition!" [nuMP| Perm_LCurrent _ |] -> return ([], IRTVarsNil) + [nuMP| Perm_LFinished |] -> return ([], IRTVarsNil) [nuMP| Perm_Struct ps |] -> irtTyVars ps [nuMP| Perm_Fun _ |] -> throwError "fun perm in an IRT definition!" @@ -660,9 +662,10 @@ instance IRTDescs (AtomicPerm a) where ([nuMP| Perm_NamedConj npn args off |], _) -> namedPermIRTDescs npn args off ixs ([nuMP| Perm_LLVMFrame _ |], _) -> return [] - ([nuMP| Perm_LOwned _ _ |], _) -> + ([nuMP| Perm_LOwned _ _ _ |], _) -> error "lowned permission made it to IRTDesc translation" ([nuMP| Perm_LCurrent _ |], _) -> return [] + ([nuMP| Perm_LFinished |], _) -> return [] ([nuMP| Perm_Struct ps |], _) -> irtDescs ps ixs ([nuMP| Perm_Fun _ |], _) -> diff --git a/heapster-saw/src/Verifier/SAW/Heapster/RustTypes.hs b/heapster-saw/src/Verifier/SAW/Heapster/RustTypes.hs index 3690d69b7f..fbd151329a 100644 --- a/heapster-saw/src/Verifier/SAW/Heapster/RustTypes.hs +++ b/heapster-saw/src/Verifier/SAW/Heapster/RustTypes.hs @@ -1056,11 +1056,11 @@ mbLifetimeFunPerm (LifetimeDef _ _ [] _) Some3FunPerm $ FunPerm (appendCruCtx (singletonCruCtx LifetimeRepr) ghosts) args ret (mbMap3 (\ps_in lops_in lops_in_abs -> - assocAppend (MNil :>: ValPerm_LOwned lops_in lops_in_abs) + assocAppend (MNil :>: ValPerm_LOwned [] lops_in lops_in_abs) ghosts args_prxs $ distPermsToValuePerms ps_in) mb_ps_in mb_lops_in mb_lops_in_abs) (mbMap3 (\ps_out lops_out lops_in_abs -> - assocAppend (MNil :>: ValPerm_LOwned lops_out lops_in_abs) + assocAppend (MNil :>: ValPerm_LOwned [] lops_out lops_in_abs) ghosts (args_prxs :>: Proxy) $ distPermsToValuePerms ps_out) mb_ps_out mb_lops_out (extMb mb_lops_in_abs)) mbLifetimeFunPerm (LifetimeDef _ _ _bounds _) _ = diff --git a/heapster-saw/src/Verifier/SAW/Heapster/TypeChecker.hs b/heapster-saw/src/Verifier/SAW/Heapster/TypeChecker.hs index 59dd836595..fddafeae6e 100644 --- a/heapster-saw/src/Verifier/SAW/Heapster/TypeChecker.hs +++ b/heapster-saw/src/Verifier/SAW/Heapster/TypeChecker.hs @@ -607,7 +607,7 @@ tcLifetimeAtomic (ExLOwned _ ls x y) = do Some x' <- tcLOwnedPerms x Some y' <- tcLOwnedPerms y ls' <- mapM tcKExpr ls - pure (Perm_LOwned x' y') + pure (Perm_LOwned ls' x' y') tcLifetimeAtomic (ExLCurrent _ l) = Perm_LCurrent <$> tcOptLifetime l tcLifetimeAtomic e = tcError (pos e) "Expected lifetime perm" From 69a272ea1e86416027067d6cdf1cebac5b6c41db Mon Sep 17 00:00:00 2001 From: Eddy Westbrook Date: Fri, 6 Aug 2021 14:32:26 -0700 Subject: [PATCH 19/28] added parser support for lfinished perms and for lowned perms with non-empty contained lifetimes --- heapster-saw/src/Verifier/SAW/Heapster/Parser.y | 13 +++++++++---- heapster-saw/src/Verifier/SAW/Heapster/Token.hs | 2 ++ .../src/Verifier/SAW/Heapster/TypeChecker.hs | 1 + .../src/Verifier/SAW/Heapster/UntypedAST.hs | 2 ++ 4 files changed, 14 insertions(+), 4 deletions(-) diff --git a/heapster-saw/src/Verifier/SAW/Heapster/Parser.y b/heapster-saw/src/Verifier/SAW/Heapster/Parser.y index 3035d01175..06cbfa28fa 100644 --- a/heapster-saw/src/Verifier/SAW/Heapster/Parser.y +++ b/heapster-saw/src/Verifier/SAW/Heapster/Parser.y @@ -66,6 +66,7 @@ import Verifier.SAW.Heapster.UntypedAST 'lifetime' { Located $$ TLifetime } 'lowned' { Located $$ TLOwned } 'lcurrent' { Located $$ TLCurrent } +'lfinished' { Located $$ TLFinished } 'rwmodality' { Located $$ TRWModality } 'permlist' { Located $$ TPermList } 'struct' { Located $$ TStruct } @@ -179,11 +180,10 @@ expr :: { AstExpr } { ExPtr (pos $2) $1 $5 $7 Nothing $10 } | 'shape' '(' expr ')' { ExShape (pos $1) $3} - | 'lowned' '(' list(varExpr) '-o' list1(varExpr) ')' - { ExLOwned (pos $1) [] $3 $5} - | 'lowned' '[' list(expr) ']' '(' list(varExpr) '-o' list1(varExpr) ')' - { ExLOwned (pos $1) $3 $6 $8} + | 'lowned' lifetimes '(' list(varExpr) '-o' list1(varExpr) ')' + { ExLOwned (pos $1) $2 $4 $6} | lifetime 'lcurrent' { ExLCurrent (pos $2) $1 } + | 'lfinished' { ExLFinished (pos $1) } -- BV Props (Value Permissions) @@ -225,6 +225,11 @@ lifetime :: { Maybe AstExpr } : { Nothing } | '[' expr ']' { Just $2 } +lifetimes :: { [AstExpr] } + : { [] } + | '[' ']' { [] } + | '[' list1R(expr) ']' { $2 } + llvmFieldPermArray :: { ArrayPerm } : lifetime '(' expr ',' expr ',' expr ')' '|->' expr { ArrayPerm (pos $9) $1 $3 $5 (Just $7) $10 } diff --git a/heapster-saw/src/Verifier/SAW/Heapster/Token.hs b/heapster-saw/src/Verifier/SAW/Heapster/Token.hs index 7c007402a2..4f342923cf 100644 --- a/heapster-saw/src/Verifier/SAW/Heapster/Token.hs +++ b/heapster-saw/src/Verifier/SAW/Heapster/Token.hs @@ -51,6 +51,7 @@ data Token | TLifetime -- ^ keyword @lifetime@ | TLOwned -- ^ keyword @lowned@ | TLCurrent -- ^ keyword @lcurrent@ + | TLFinished -- ^ keyword @lfinished@ | TRWModality -- ^ keyword @rwmodality@ | TPermList -- ^ keyword @permlist@ | TStruct -- ^ keyword @struct@ @@ -130,6 +131,7 @@ describeToken t = TLifetime -> "keyword 'lifetime'" TLOwned -> "keyword 'lowned'" TLCurrent -> "keyword 'lcurrent'" + TLFinished -> "keyword 'lfinished'" TRWModality -> "keyword 'rwmodality'" TPermList -> "keyword 'permlist'" TStruct -> "keyword 'struct'" diff --git a/heapster-saw/src/Verifier/SAW/Heapster/TypeChecker.hs b/heapster-saw/src/Verifier/SAW/Heapster/TypeChecker.hs index fddafeae6e..b0cb527e98 100644 --- a/heapster-saw/src/Verifier/SAW/Heapster/TypeChecker.hs +++ b/heapster-saw/src/Verifier/SAW/Heapster/TypeChecker.hs @@ -609,6 +609,7 @@ tcLifetimeAtomic (ExLOwned _ ls x y) = ls' <- mapM tcKExpr ls pure (Perm_LOwned ls' x' y') tcLifetimeAtomic (ExLCurrent _ l) = Perm_LCurrent <$> tcOptLifetime l +tcLifetimeAtomic (ExLFinished _) = return Perm_LFinished tcLifetimeAtomic e = tcError (pos e) "Expected lifetime perm" -- | Helper for lowned permission checking diff --git a/heapster-saw/src/Verifier/SAW/Heapster/UntypedAST.hs b/heapster-saw/src/Verifier/SAW/Heapster/UntypedAST.hs index 475ae1d3de..5716636ad2 100644 --- a/heapster-saw/src/Verifier/SAW/Heapster/UntypedAST.hs +++ b/heapster-saw/src/Verifier/SAW/Heapster/UntypedAST.hs @@ -71,6 +71,7 @@ data AstExpr | ExEq Pos AstExpr -- ^ equal permission | ExLOwned Pos [AstExpr] [(Located String, AstExpr)] [(Located String, AstExpr)] -- ^ owned permission | ExLCurrent Pos (Maybe AstExpr) -- ^ current permission + | ExLFinished Pos -- ^ finished permission | ExShape Pos AstExpr -- ^ shape literal | ExFree Pos AstExpr -- ^ free literal | ExPtr Pos (Maybe AstExpr) AstExpr AstExpr (Maybe AstExpr) AstExpr -- ^ pointer permission @@ -108,6 +109,7 @@ instance HasPos AstExpr where pos (ExLessEqual p _ _ ) = p pos (ExLOwned p _ _ _ ) = p pos (ExLCurrent p _ ) = p + pos (ExLFinished p ) = p pos (ExShape p _ ) = p pos (ExFree p _ ) = p pos (ExPtr p _ _ _ _ _) = p From 91e4e9a7ab035074aa4d634c5bd9fcc9891ae96a Mon Sep 17 00:00:00 2001 From: Eddy Westbrook Date: Mon, 9 Aug 2021 05:59:35 -0700 Subject: [PATCH 20/28] whoops, fixed the parser rules for an optional list of lifetimes --- heapster-saw/src/Verifier/SAW/Heapster/Parser.y | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/heapster-saw/src/Verifier/SAW/Heapster/Parser.y b/heapster-saw/src/Verifier/SAW/Heapster/Parser.y index 06cbfa28fa..643b9fcefc 100644 --- a/heapster-saw/src/Verifier/SAW/Heapster/Parser.y +++ b/heapster-saw/src/Verifier/SAW/Heapster/Parser.y @@ -227,8 +227,7 @@ lifetime :: { Maybe AstExpr } lifetimes :: { [AstExpr] } : { [] } - | '[' ']' { [] } - | '[' list1R(expr) ']' { $2 } + | '[' list(expr) ']' { $2 } llvmFieldPermArray :: { ArrayPerm } : lifetime '(' expr ',' expr ',' expr ')' '|->' expr From a1a1f68c22c862bafd7071e1160f426337088b46 Mon Sep 17 00:00:00 2001 From: Eddy Westbrook Date: Mon, 9 Aug 2021 10:31:13 -0700 Subject: [PATCH 21/28] trying out a new approach for proving lowned permissions: instead of casting both sides to incorporate the equality permissions, change solveForPermListImpl to incorporate those equality permissions --- .../src/Verifier/SAW/Heapster/Implication.hs | 164 ++++++++++-------- 1 file changed, 91 insertions(+), 73 deletions(-) diff --git a/heapster-saw/src/Verifier/SAW/Heapster/Implication.hs b/heapster-saw/src/Verifier/SAW/Heapster/Implication.hs index b9c70eefd6..c95126015b 100644 --- a/heapster-saw/src/Verifier/SAW/Heapster/Implication.hs +++ b/heapster-saw/src/Verifier/SAW/Heapster/Implication.hs @@ -50,6 +50,7 @@ import qualified Data.Binding.Hobbits.NameSet as NameSet import Prettyprinter as PP import Data.Parameterized.BoolRepr +import Data.Parameterized.TraversableF import Lang.Crucible.Types import Lang.Crucible.LLVM.MemModel @@ -205,10 +206,17 @@ someEqProofRHS :: SomeEqProof a -> a someEqProofRHS (SomeEqProofRefl a) = a someEqProofRHS (SomeEqProofCons _ eq_step) = eqProofStepRHS eq_step +-- | Get all the equality permissions used by a 'SomeEqProof' +someEqProofPerms :: SomeEqProof a -> Some DistPerms +someEqProofPerms (SomeEqProofRefl _) = Some MNil +someEqProofPerms (SomeEqProofCons some_eqp eq_step) + | Some ps <- someEqProofPerms some_eqp = + Some (RL.append ps $ eqProofStepPerms eq_step) + -- | Construct a 'SomeEqProof' for @x=e@ or @e=x@ using an @x:eq(e)@ permission, -- where the 'Bool' flag is 'True' for @x=e@ and 'False' for @e=x@ like 'EqPerm' -someEqProofPerm :: ExprVar a -> PermExpr a -> Bool -> SomeEqProof (PermExpr a) -someEqProofPerm x e flag = +someEqProof1 :: ExprVar a -> PermExpr a -> Bool -> SomeEqProof (PermExpr a) +someEqProof1 x e flag = let eq_step = EqProofStep (MNil :>: EqPerm x e flag) (\(_ :>: e') -> e') in SomeEqProofCons (SomeEqProofRefl $ eqProofStepLHS eq_step) eq_step @@ -2886,6 +2894,11 @@ getDistPerms = use (implStatePerms . distPerms) getTopDistPerm :: ExprVar a -> ImplM vars s r (ps :> a) (ps :> a) (ValuePerm a) getTopDistPerm x = use (implStatePerms . topDistPerm x) +-- | Get a sequence of the top @N@ permissions on the stack +getTopDistPerms :: prx1 ps1 -> RAssign prx2 ps2 -> + ImplM vars s r (ps1 :++: ps2) (ps1 :++: ps2) (DistPerms ps2) +getTopDistPerms ps1 ps2 = snd <$> RL.split ps1 ps2 <$> getDistPerms + -- | Set the current 'PermSet' setPerms :: PermSet ps -> ImplM vars s r ps ps () setPerms perms = implStatePerms .= perms @@ -4242,11 +4255,14 @@ recombinePermExpl x x_p p = permPretty info p) $ -} recombinePerm' x x_p p +-- | This is the implementation of 'recombinePermExpl'; see the documentation +-- for that function for details recombinePerm' :: NuMatchingAny1 r => ExprVar a -> ValuePerm a -> ValuePerm a -> ImplM vars s r as (as :> a) () recombinePerm' x _ p@ValPerm_True = implDropM x p +recombinePerm' x _ p@(ValPerm_Eq (PExpr_Var y)) | y == x = implDropM x p recombinePerm' x ValPerm_True (ValPerm_Eq e) = - simplEqPerm x e >>>= \e' -> implPopM x (ValPerm_Eq e') + simplEqPerm x e >>>= \e' -> implPopM x (ValPerm_Eq e') recombinePerm' x ValPerm_True p = implPopM x p recombinePerm' x (ValPerm_Eq (PExpr_Var y)) _ | y == x = error "recombinePerm: variable x has permission eq(x)!" @@ -4501,11 +4517,11 @@ proveEqH psubst e mb_e = case (e, mbMatch mb_e) of (ValPerm_Eq e', _) -> -- If we have x:eq(e'), prove e' = y and apply transitivity proveEq e' mb_e >>= \some_eqp -> - pure $ someEqProofTrans (someEqProofPerm x e' True) some_eqp + pure $ someEqProofTrans (someEqProof1 x e' True) some_eqp (_, ValPerm_Eq e') -> -- If we have y:eq(e'), prove x = e' and apply transitivity proveEq e (fmap (const e') mb_e) >>= \some_eqp -> - pure $ someEqProofTrans some_eqp (someEqProofPerm y e' False) + pure $ someEqProofTrans some_eqp (someEqProof1 y e' False) (_, _) -> -- If we have no equality perms, eliminate perms on x and y to see if we -- can get one; if so, recurse, and otherwise, raise an error @@ -4520,7 +4536,7 @@ proveEqH psubst e mb_e = case (e, mbMatch mb_e) of getVarEqPerm x >>= \case Just e' -> proveEq e' mb_e >>= \eqp2 -> - pure (someEqProofTrans (someEqProofPerm x e' True) eqp2) + pure (someEqProofTrans (someEqProof1 x e' True) eqp2) Nothing -> proveEqFail e mb_e -- To prove e=x, try to see if x:eq(e') and proceed by transitivity @@ -4529,7 +4545,7 @@ proveEqH psubst e mb_e = case (e, mbMatch mb_e) of getVarEqPerm x >>= \case Just e' -> proveEq e (fmap (const e') mb_e) >>= \eqp -> - pure (someEqProofTrans eqp (someEqProofPerm x e' False)) + pure (someEqProofTrans eqp (someEqProof1 x e' False)) Nothing -> proveEqFail e mb_e -- FIXME: if proving word(e1)=word(e2) for ground e2, we could add an assertion @@ -4653,6 +4669,15 @@ proveVarLifetimeFunctor' x f args l mb_l psubst = case mbMatch mb_l of -- | A sequence of permissions in bindings that need to be proved type NeededPerms vars = Some (RAssign (Compose (Mb vars) VarAndPerm)) +-- | Append two existentially quantified 'RAssign' lists +apSomeRAssign :: Some (RAssign f) -> Some (RAssign f) -> Some (RAssign f) +apSomeRAssign (Some x) (Some y) = Some (RL.append x y) + +-- | Concatenate a list of existentially quantified 'RAssign' lists +concatSomeRAssign :: [Some (RAssign f)] -> Some (RAssign f) +concatSomeRAssign = foldl apSomeRAssign (Some MNil) +-- foldl is intentional, appending RAssign matches on the second argument + -- | Convert a 'NeededPerms' list to an 'ExDistPerms' neededPermsToExDistPerms :: RAssign prx vars -> RAssign (Compose (Mb vars) VarAndPerm) ps -> @@ -4665,16 +4690,21 @@ neededPermsToExDistPerms vars (ps :>: Compose mb_vap) = neededPerms1 :: Mb vars (ExprVar a) -> Mb vars (ValuePerm a) -> NeededPerms vars neededPerms1 mb_x mb_p = Some (MNil :>: Compose (mbMap2 VarAndPerm mb_x mb_p)) --- | If the second argument is an unset lifetime variable, set it to the first, --- otherwise do nothing -tryUnifyLifetimes :: PermExpr LifetimeType -> Mb vars (PermExpr LifetimeType) -> - ImplM vars s r ps ps () -tryUnifyLifetimes l mb_l = case mbMatch mb_l of - [nuMP| PExpr_Var mb_l' |] - | Left memb <- mbNameBoundP mb_l' -> +-- | Convert an existential 'DistPerms' not in a binding to a 'NeededPerms' +someDistPermsToNeededPerms :: RAssign Proxy vars -> Some DistPerms -> + NeededPerms vars +someDistPermsToNeededPerms prxs = + fmapF $ RL.map (Compose . nuMulti prxs . const) + +-- | If the second argument is an unset variable, set it to the first, otherwise +-- do nothing +tryUnifyVars :: PermExpr a -> Mb vars (PermExpr a) -> ImplM vars s r ps ps () +tryUnifyVars x mb_x = case mbMatch mb_x of + [nuMP| PExpr_Var mb_x' |] + | Left memb <- mbNameBoundP mb_x' -> do psubst <- getPSubst case psubstLookup psubst memb of - Nothing -> setVarM memb l + Nothing -> setVarM memb x _ -> pure () _ -> pure () @@ -4702,7 +4732,8 @@ solveForPermListImplBlock (ps_l :>: LOwnedPermBlock (PExpr_Var y) bp_l) x mb_bp | Just Refl <- testEquality x y , rng_l <- llvmBlockRange bp_l , [nuMP| Just mb_bps |] <- mbMatch $ fmap (remLLVMBLockPermRange rng_l) mb_bp = - tryUnifyLifetimes (llvmBlockLifetime bp_l) (fmap llvmBlockLifetime mb_bp) >>> + tryUnifyVars (llvmBlockLifetime bp_l) (fmap llvmBlockLifetime mb_bp) >>> + tryUnifyVars (llvmBlockRW bp_l) (fmap llvmBlockRW mb_bp) >>> concatSomeRAssign <$> mapM (solveForPermListImplBlock ps_l x) (mbList mb_bps) -- Otherwise, recurse on the tail of the permission list @@ -4710,14 +4741,12 @@ solveForPermListImplBlock (ps_l :>: _) x mb_bp = solveForPermListImplBlock ps_l x mb_bp --- | Determine what additional permissions from the variable permissions, if --- any, would be needed to prove one list of permissions implies another. Also --- instantiate any existential variables as needed for the implication. This is --- just a "best guess", so just do nothing and return if nothing can be done. -solveForPermListImpl :: NuMatchingAny1 r => LOwnedPerms ps_l -> - Mb vars (LOwnedPerms ps_r) -> - ImplM vars s r ps ps (NeededPerms vars) -solveForPermListImpl ps_l mb_ps = case mbMatch mb_ps of +-- | The second stage of 'solveForPermListImpl', after equality permissions have +-- been substituted into the 'LOwnedPerms' +solveForPermListImpl1 :: NuMatchingAny1 r => LOwnedPerms ps_l -> + Mb vars (LOwnedPerms ps_r) -> + ImplM vars s r ps ps (NeededPerms vars) +solveForPermListImpl1 ps_l mb_ps = case mbMatch mb_ps of -- If the RHS is empty, we are done [nuMP| MNil |] -> @@ -4729,26 +4758,38 @@ solveForPermListImpl ps_l mb_ps = case mbMatch mb_ps of | Right x <- mbNameBoundP mb_x , mb_bp <- fmap llvmFieldPermToBlock mb_fp -> do needed1 <- solveForPermListImplBlock ps_l x mb_bp - needed2 <- solveForPermListImpl ps_l mb_ps_r + needed2 <- solveForPermListImpl1 ps_l mb_ps_r pure (apSomeRAssign needed1 needed2) -- If the RHS starts with a block perm, call solveForPermListImplBlock [nuMP| mb_ps_r :>: LOwnedPermBlock (PExpr_Var mb_x) mb_bp |] | Right x <- mbNameBoundP mb_x -> do needed1 <- solveForPermListImplBlock ps_l x mb_bp - needed2 <- solveForPermListImpl ps_l mb_ps_r + needed2 <- solveForPermListImpl1 ps_l mb_ps_r pure (apSomeRAssign needed1 needed2) -- Otherwise, we don't know what to do, so do nothing and return _ -> pure (Some MNil) -concatSomeRAssign :: [Some (RAssign f)] -> Some (RAssign f) -concatSomeRAssign = foldl apSomeRAssign (Some MNil) --- foldl is intentional, appending RAssign matches on the second argument -apSomeRAssign :: Some (RAssign f) -> Some (RAssign f) -> Some (RAssign f) -apSomeRAssign (Some x) (Some y) = Some (RL.append x y) +-- | Determine what additional permissions from the variable permissions, if +-- any, would be needed to prove one list of permissions implies another. Also +-- instantiate any existential variables as needed for the implication. This is +-- just a "best guess", so just do nothing and return if nothing can be done. +solveForPermListImpl :: NuMatchingAny1 r => LOwnedPerms ps_l -> + Mb vars (LOwnedPerms ps_r) -> + ImplM vars s r ps ps (NeededPerms vars) +solveForPermListImpl ps_l mb_ps_r = + let prxs = mbToProxy mb_ps_r in + substEqsWithProof ps_l >>>= \eqp_l -> + give prxs (substEqsWithProof mb_ps_r) >>>= \eqp_r -> + let neededs = + someDistPermsToNeededPerms prxs $ + apSomeRAssign (someEqProofPerms eqp_l) (someEqProofPerms eqp_r) in + apSomeRAssign neededs <$> + solveForPermListImpl1 (someEqProofRHS eqp_l) (someEqProofRHS eqp_r) + ---------------------------------------------------------------------- -- * Proving Field Permissions @@ -6234,29 +6275,16 @@ proveVarAtomicImpl x ps mb_p = case mbMatch mb_p of [nuMP| Perm_LOwned [] mb_ps_inR mb_ps_outR |] | [Perm_LOwned [] ps_inL ps_outL] <- ps -> - -- First, simplify both sides using any current equality permissions. This - -- just builds the equality proofs and computes the new LHS and RHS, but - -- we don't actually perform the casts until later. - substEqsWithProof (ps_inL, ps_outL) >>>= \eqp_psL -> - get >>>= \s -> - give (cruCtxProxies (view implStateVars s)) - (substEqsWithProof (mb_ps_inR, mb_ps_outR)) >>>= \eqp_mb_psR -> - let (ps_inL',ps_outL') = someEqProofRHS eqp_psL - (mb_ps_inR',mb_ps_outR') = someEqProofRHS eqp_mb_psR in - - -- Pop ps from the stack, so we can push it to the top of the stack later - implPopM x (ValPerm_Conj ps) >>> - -- Compute the necessary "permission subtractions" to figure out what -- additional permissions are needed to prove both ps_inR -o ps_inL and - -- ps_outL -o ps_outR. These required permissions are calls ps1 and ps2, + -- ps_outL -o ps_outR. These required permissions are called ps1 and ps2, -- respectively. Note that the RHS for both of these implications needs to -- be in a name-binding for the evars and the LHS needs to not be in a -- name-binding, so ps_inR cannot have any evars. - partialSubstForceM mb_ps_inR' "proveVarAtomicImpl" >>>= \ps_inR' -> - let mb_ps_inL' = fmap (const ps_inL') mb_ps_inR' in - solveForPermListImpl ps_inR' mb_ps_inL' >>>= \(Some neededs1) -> - solveForPermListImpl ps_outL' mb_ps_outR' >>>= \(Some neededs2) -> + partialSubstForceM mb_ps_inR "proveVarAtomicImpl" >>>= \ps_inR -> + let mb_ps_inL = fmap (const ps_inL) mb_ps_inR in + solveForPermListImpl ps_inR mb_ps_inL >>>= \(Some neededs1) -> + solveForPermListImpl ps_outL mb_ps_outR >>>= \(Some neededs2) -> uses implStateVars cruCtxProxies >>>= \prxs -> let mb_ps1 = neededPermsToExDistPerms prxs neededs1 mb_ps2 = neededPermsToExDistPerms prxs neededs2 in @@ -6266,38 +6294,28 @@ proveVarAtomicImpl x ps mb_p = case mbMatch mb_p of -- of the stack. We do it this way because we can't substitute expressions -- for variables in a DistPerms, because DistPerms need to have variables -- on the LHSs and not arbitrary expressions - getDistPerms >>>= \before_ps -> + getDistPerms >>>= \ps0_with_a -> + let ps0 = RL.tail ps0_with_a in proveVarsImplAppendInt (mbMap2 RL.append mb_ps1 mb_ps2) >>> - getDistPerms >>>= \top_ps -> - let ps12 = snd $ RL.split before_ps (RL.append neededs1 neededs2) top_ps - (ps1,ps2) = RL.split neededs1 neededs2 ps12 in - partialSubstForceM mb_ps_outR' "proveVarAtomicImpl" >>>= \ps_outR' -> - getPSubst >>>= \psubst -> - let eqp_R = - fmap (\(mb_ps_in,mb_ps_out) -> - ValPerm_LOwned [] - (partialSubstForce psubst mb_ps_in "proveVarAtomicImpl") - (partialSubstForce psubst mb_ps_out "proveVarAtomicImpl")) - eqp_mb_psR in + getTopDistPerms ps0_with_a (RL.append neededs1 neededs2) >>>= \ps12 -> + let (ps1,ps2) = RL.split neededs1 neededs2 ps12 in + partialSubstForceM mb_ps_outR "proveVarAtomicImpl" >>>= \ps_outR -> -- Build the local implications ps_inR -o ps_inL and ps_outL -o ps_outR - (case (lownedPermsToDistPerms ps_inL', lownedPermsToDistPerms ps_outL', - lownedPermsToDistPerms ps_inR', lownedPermsToDistPerms ps_outR') of + (case (lownedPermsToDistPerms ps_inL, lownedPermsToDistPerms ps_outL, + lownedPermsToDistPerms ps_inR, lownedPermsToDistPerms ps_outR) of (Just dps_inL, Just dps_outL, Just dps_inR, Just dps_outR) -> pure (dps_inL, dps_outL, dps_inR, dps_outR) - _ -> implFailM "proveVarAtomicImpl: lownedPermsToDistPerms") + _ -> implFailMsgM "proveVarAtomicImpl: lownedPermsToDistPerms") >>>= \(dps_inL, dps_outL, dps_inR, dps_outR) -> localProveVars (RL.append ps1 dps_inR) dps_inL >>>= \impl_in -> localProveVars (RL.append ps2 dps_outL) dps_outR >>>= \impl_out -> - -- Finally, apply the MapLifetime proof step, first pushing the input - -- lowned permissions and casting it, and then cast the result - implPushM x (ValPerm_Conj ps) >>> - implCastPermM x (fmap (\(ps_in,ps_out) -> - ValPerm_LOwned [] ps_in ps_out) eqp_psL) >>> - implSimplM Proxy (SImpl_MapLifetime x [] ps_inL' ps_outL' ps_inR' ps_outR' - ps1 ps2 impl_in impl_out) >>> - implCastPermM x (someEqProofSym eqp_R) + -- Finally, apply the MapLifetime proof step, first moving the input + -- lowned permissions to the top of the stack + implMoveUpM ps0 ps12 x MNil >>> + implSimplM Proxy (SImpl_MapLifetime x [] ps_inL ps_outL ps_inR ps_outR + ps1 ps2 impl_in impl_out) [nuMP| Perm_LCurrent mb_l' |] -> partialSubstForceM mb_l' "proveVarAtomicImpl" >>>= \l' -> @@ -7024,7 +7042,7 @@ proveVarsImplVarEVars mb_ps = getPSubst >>>= \psubst -> let s = completePSubst vars psubst in let vars_eqpf = - traverseRAssign (\(Pair x e) -> someEqProofPerm x e False) $ + traverseRAssign (\(Pair x e) -> someEqProof1 x e False) $ RL.map2 Pair xs (exprsOfSubst s) in let perms_eqpf = fmap (\es -> subst (substOfExprs es) $ mbDistPermsToValuePerms mb_ps) vars_eqpf in From 84dbd114d257337976b66b5c8040b2d2fd51b0b1 Mon Sep 17 00:00:00 2001 From: Eddy Westbrook Date: Tue, 10 Aug 2021 07:00:49 -0700 Subject: [PATCH 22/28] fixed localProveVars to recombine the input permissions in reverse order, since the left-most permissions (including any relevant equality permissions) are actually expected to be recombined first --- .../src/Verifier/SAW/Heapster/Implication.hs | 19 ++++++++++++++++++- 1 file changed, 18 insertions(+), 1 deletion(-) diff --git a/heapster-saw/src/Verifier/SAW/Heapster/Implication.hs b/heapster-saw/src/Verifier/SAW/Heapster/Implication.hs index c95126015b..465e1d75d8 100644 --- a/heapster-saw/src/Verifier/SAW/Heapster/Implication.hs +++ b/heapster-saw/src/Verifier/SAW/Heapster/Implication.hs @@ -4393,6 +4393,23 @@ recombinePermsPartial _ DistPermsNil = pure () recombinePermsPartial ps (DistPermsCons ps' x p) = recombinePerm x p >>> recombinePermsPartial ps ps' +-- | Recombine some of the permissions on the stack back into the permission +-- set, but in reverse order +recombinePermsRevPartial :: NuMatchingAny1 r => RAssign Proxy ps1 -> DistPerms ps2 -> + ImplM vars s r ps1 (ps1 :++: ps2) () +recombinePermsRevPartial _ DistPermsNil = return () +recombinePermsRevPartial ps1 ps2@(DistPermsCons ps2' x p) = + implMoveDownM ps1 (RL.map (const Proxy) ps2) x MNil >>> + recombinePermsRevPartial (ps1 :>: Proxy) ps2' >>> + recombinePerm x p + +-- | Recombine the permissions on the stack back into the permission set, but in +-- reverse order +recombinePermsRev :: NuMatchingAny1 r => DistPerms ps -> + ImplM vars s r RNil ps () +recombinePermsRev ps + | Refl <- RL.prependRNilEq ps = recombinePermsRevPartial MNil ps + -- | Recombine the permissions for a 'LifetimeCurrentPerms' list recombineLifetimeCurrentPerms :: NuMatchingAny1 r => LifetimeCurrentPerms ps_l -> @@ -6956,7 +6973,7 @@ localProveVars ps_in ps_out = implTraceM (\i -> sep [pretty "localProveVars:", permPretty i ps_in, pretty "-o", permPretty i ps_out]) >>> LocalPermImpl <$> - embedImplM ps_in (recombinePerms ps_in >>> + embedImplM ps_in (recombinePermsRev ps_in >>> proveVarsImplInt (emptyMb ps_out) >>> pure (LocalImplRet Refl)) From 0322bea40452c44ceb01c41629b8f44a95ac4b2c Mon Sep 17 00:00:00 2001 From: Eddy Westbrook Date: Tue, 10 Aug 2021 09:10:53 -0700 Subject: [PATCH 23/28] changed instantiateLifetimeVars to explicitly look for lowned permissions for the lifetimes it instantiates; also added debug tracing for when lifetimes begin and end --- heapster-saw/src/Verifier/SAW/Heapster/Implication.hs | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) diff --git a/heapster-saw/src/Verifier/SAW/Heapster/Implication.hs b/heapster-saw/src/Verifier/SAW/Heapster/Implication.hs index 465e1d75d8..0b99e8f7c4 100644 --- a/heapster-saw/src/Verifier/SAW/Heapster/Implication.hs +++ b/heapster-saw/src/Verifier/SAW/Heapster/Implication.hs @@ -3711,6 +3711,7 @@ implBeginLifetimeM = implApplyImpl1 Impl1_BeginLifetime (MNil :>: Impl1Cont (\(_ :>: n) -> pure n)) >>>= \l -> implPopM l (ValPerm_LOwned [] MNil MNil) >>> + implTraceM (\i -> pretty "Beginning lifetime:" <+> permPretty i l) >>> pure l -- | End a lifetime, assuming the top of the stack is of the form @@ -3725,8 +3726,7 @@ implEndLifetimeM :: NuMatchingAny1 r => Proxy ps -> ExprVar LifetimeType -> implEndLifetimeM ps l ps_in ps_out@(lownedPermsToDistPerms -> Just dps_out) | isJust (lownedPermsToDistPerms ps_in) = implSimplM ps (SImpl_EndLifetime l ps_in ps_out) >>> - implTraceM (\i -> pretty "Lifetime" <+> - permPretty i l <+> pretty "ended") >>> + implTraceM (\i -> pretty "Ending lifetime:" <+> permPretty i l) >>> recombinePermsPartial ps (DistPermsCons dps_out l ValPerm_LFinished) implEndLifetimeM _ _ _ _ = implFailM "implEndLifetimeM: lownedPermsToDistPerms" @@ -6908,7 +6908,7 @@ findProvablePerm mbUnsetVars mb_ps = case mbMatch mb_ps of (best_rank, extExDistPermsSplit best mb_x mb_p) --- | Find all existential lifetime variables that are assigned permissions in an +-- | Find all existential lifetime variables with @lowned@ permissions in an -- 'ExDistPerms' list, and instantiate them with fresh lifetimes instantiateLifetimeVars :: NuMatchingAny1 r => ExDistPerms vars ps -> ImplM vars s r ps_in ps_in () @@ -6921,9 +6921,8 @@ instantiateLifetimeVars' :: NuMatchingAny1 r => PartialSubst vars -> ExDistPerms vars ps -> ImplM vars s r ps_in ps_in () instantiateLifetimeVars' psubst mb_ps = case mbMatch mb_ps of [nuMP| DistPermsNil |] -> pure () - [nuMP| DistPermsCons mb_ps' mb_x (ValPerm_Conj1 mb_p) |] - | Just Refl <- mbLift $ fmap isLifetimePerm mb_p - , Left memb <- mbNameBoundP mb_x + [nuMP| DistPermsCons mb_ps' mb_x (ValPerm_LOwned _ _ _) |] + | Left memb <- mbNameBoundP mb_x , Nothing <- psubstLookup psubst memb -> implBeginLifetimeM >>>= \l -> setVarM memb (PExpr_Var l) >>> From d71ae9b70ebc9efc0c45ac5b3180c9973c4642b3 Mon Sep 17 00:00:00 2001 From: Eddy Westbrook Date: Tue, 10 Aug 2021 13:21:01 -0700 Subject: [PATCH 24/28] changed implEndLifetimeRecM to no longer leave the lfinished permission on top of the stack, but to instead remove the finished lifetime from any other lowned permissions; also setPerm and setPerms, which have not been used in a long time --- .../src/Verifier/SAW/Heapster/Implication.hs | 70 +++++++++++-------- 1 file changed, 40 insertions(+), 30 deletions(-) diff --git a/heapster-saw/src/Verifier/SAW/Heapster/Implication.hs b/heapster-saw/src/Verifier/SAW/Heapster/Implication.hs index 0b99e8f7c4..37325ad95c 100644 --- a/heapster-saw/src/Verifier/SAW/Heapster/Implication.hs +++ b/heapster-saw/src/Verifier/SAW/Heapster/Implication.hs @@ -2899,13 +2899,13 @@ getTopDistPerms :: prx1 ps1 -> RAssign prx2 ps2 -> ImplM vars s r (ps1 :++: ps2) (ps1 :++: ps2) (DistPerms ps2) getTopDistPerms ps1 ps2 = snd <$> RL.split ps1 ps2 <$> getDistPerms --- | Set the current 'PermSet' -setPerms :: PermSet ps -> ImplM vars s r ps ps () -setPerms perms = implStatePerms .= perms - --- | Set the current permission for a given variable -setPerm :: ExprVar a -> ValuePerm a -> ImplM vars s r ps ps () -setPerm x p = implStatePerms . varPerm x .= p +-- | Find all @lowned@ permissions held in in the variable permissions +implFindLOwnedPerms :: ImplM vars s r ps ps [(ExprVar LifetimeType, + ValuePerm LifetimeType)] +implFindLOwnedPerms = + mapMaybe (\case NameAndElem l p@(ValPerm_LOwned _ _ _) -> Just (l,p) + _ -> Nothing) <$> + NameMap.assocs <$> view varPermMap <$> getPerms -- | Look up the type of a free variable implGetVarType :: Name a -> ImplM vars s r ps ps (TypeRepr a) @@ -3716,10 +3716,11 @@ implBeginLifetimeM = -- | End a lifetime, assuming the top of the stack is of the form -- --- > ps_in, l:lowned(ps_in -o ps_out) +-- > ps, ps_in, l:lowned(ps_in -o ps_out) -- --- Recombine all the returned permissions @ps_out@ and @l:lfinished@, leaving --- just @ps@ on the stack. +-- Remove @l@ from any other @lowned@ permissions held by other variables. +-- Recombine all the returned permissions @ps_out@ and @l:lfinished@ returned by +-- ending @l@, leaving just @ps@ on the stack. implEndLifetimeM :: NuMatchingAny1 r => Proxy ps -> ExprVar LifetimeType -> LOwnedPerms ps_in -> LOwnedPerms ps_out -> ImplM vars s r ps (ps :++: ps_in :> LifetimeType) () @@ -3730,7 +3731,6 @@ implEndLifetimeM ps l ps_in ps_out@(lownedPermsToDistPerms -> Just dps_out) recombinePermsPartial ps (DistPermsCons dps_out l ValPerm_LFinished) implEndLifetimeM _ _ _ _ = implFailM "implEndLifetimeM: lownedPermsToDistPerms" - -- | Save a permission for later by splitting it into part that is in the -- current lifetime and part that is saved in the lifetime for later. Assume -- permissions @@ -6284,9 +6284,8 @@ proveVarAtomicImpl x ps mb_p = case mbMatch mb_p of -- FIXME HERE: eventually we should handle lowned permissions on the right -- with arbitrary contained lifetimes, by equalizing the two sides [nuMP| Perm_LOwned [] _ _ |] - | [Perm_LOwned ls@(PExpr_Var l2:_) ps_in ps_out] <- ps -> - implEndLifetimeRecM l2 >>> - implRemoveContainedLifetimeM x ls ps_in ps_out l2 >>> + | [Perm_LOwned (PExpr_Var l2:_) _ _] <- ps -> + implPopM x (ValPerm_Conj ps) >>> implEndLifetimeRecM l2 >>> proveVarImplInt x (fmap ValPerm_Conj1 mb_p) [nuMP| Perm_LOwned [] mb_ps_inR mb_ps_outR |] @@ -6352,7 +6351,8 @@ proveVarAtomicImpl x ps mb_p = case mbMatch mb_p of _ -> proveVarAtomicImplUnfoldOrFail x ps mb_p [nuMP| Perm_LFinished |] -> - implPopM x (ValPerm_Conj ps) >>> implEndLifetimeRecM x + implPopM x (ValPerm_Conj ps) >>> implEndLifetimeRecM x >>> + implPushCopyM x ValPerm_LFinished -- If we have a struct permission on the left, eliminate it to a sequence of -- variables and prove the required permissions for each variable @@ -6984,26 +6984,37 @@ localProveVars ps_in ps_out = -- | End a lifetime and, recursively, all lifetimes it contains, assuming that -- @lowned@ permissions are held for all of those lifetimes. For each lifetime -- that is ended, prove its required input permissions and recombine the --- resulting output permissions. If a lifetime has already ended, do nothing. --- Leave an @lfinished@ permission for that lifetime on the top of the stack. +-- resulting output permissions. Also remove each ended lifetime from any +-- @lowned@ permission in the variable permissions that contains it. If a +-- lifetime has already ended, do nothing. implEndLifetimeRecM :: NuMatchingAny1 r => ExprVar LifetimeType -> - ImplM vars s r (ps :> LifetimeType) ps () + ImplM vars s r ps ps () implEndLifetimeRecM l = getPerm l >>>= \case - p@ValPerm_LFinished -> implPushCopyM l p + ValPerm_LFinished -> return () p@(ValPerm_LOwned [] ps_in ps_out) | Just dps_in <- lownedPermsToDistPerms ps_in -> + -- Get the permission stack on entry + getDistPerms >>>= \ps0 -> + -- Save the lowned permission for l + implPushM l p >>> + -- Prove the required input permissions ps_in for ending l mbVarsM dps_in >>>= \mb_dps_in -> - -- NOTE: we are assuming that l's permission, p, will not change during - -- this recursive call to the prover, which should be safe proveVarsImplAppendInt mb_dps_in >>> - implPushM l p >>> implEndLifetimeM Proxy l ps_in ps_out >>> - implPushCopyM l ValPerm_LFinished - p@(ValPerm_LOwned ((asVar -> Just l') : ls) ps_in ps_out) -> - implPushM l p >>> - implEndLifetimeRecM l' >>> - implRemoveContainedLifetimeM l ls ps_in ps_out l' >>> - implEndLifetimeRecM l + -- Move the lowned permission for l to the top of the stack + implMoveUpM ps0 ps_in l MNil >>> + -- End l + implEndLifetimeM Proxy l ps_in ps_out >>> + -- Find all lowned perms that contain l and remove l from them + implFindLOwnedPerms >>>= \lowned_ps -> + forM_ lowned_ps $ \case + (l', p'@(ValPerm_LOwned ls' ps_in' ps_out')) + | elem (PExpr_Var l) ls' -> + implPushM l' p' >>> implPushCopyM l ValPerm_LFinished >>> + implRemoveContainedLifetimeM l' ls' ps_in' ps_out' l + _ -> return () + (ValPerm_LOwned ((asVar -> Just l') : _) _ _) -> + implEndLifetimeRecM l' >>> implEndLifetimeRecM l _ -> implTraceM (\i -> pretty "implEndLifetimeRecM: could not end lifetime: " <> @@ -7030,8 +7041,7 @@ proveVarsImplAppend mb_ps = sep [pretty "Ending lifetime" <+> permPretty i l, pretty "in order to prove:", permPretty i mb_ps]) >>> - implEndLifetimeRecM l >>> implDropM l ValPerm_LFinished >>> - proveVarsImplAppend mb_ps)) + implEndLifetimeRecM l >>> proveVarsImplAppend mb_ps)) -- | Prove a list of existentially-quantified distinguished permissions and put -- those proofs onto the stack. This is the same as 'proveVarsImplAppend' except From 22ebbb6fbd7b383e00605ee630252cb79bdad15e Mon Sep 17 00:00:00 2001 From: Eddy Westbrook Date: Tue, 10 Aug 2021 13:21:49 -0700 Subject: [PATCH 25/28] added a case to simplify1PermForDetVars to end any indetermined lifetimes contained in lowned permissions for determined lifetimes --- heapster-saw/src/Verifier/SAW/Heapster/TypedCrucible.hs | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/heapster-saw/src/Verifier/SAW/Heapster/TypedCrucible.hs b/heapster-saw/src/Verifier/SAW/Heapster/TypedCrucible.hs index cd4b589cb5..b908cf8a9a 100644 --- a/heapster-saw/src/Verifier/SAW/Heapster/TypedCrucible.hs +++ b/heapster-saw/src/Verifier/SAW/Heapster/TypedCrucible.hs @@ -3596,6 +3596,15 @@ simplify1PermForDetVars det_vars x (ValPerm_Conj ps) getPerm x >>>= \new_p -> simplify1PermForDetVars det_vars x new_p +-- For lowned permission l:lowned[ls](ps_in -o ps_out), end any lifetimes in ls +-- that are not determined and remove them from the lowned permission for ls +simplify1PermForDetVars det_vars l (ValPerm_LOwned ls _ _) + | l':_ <- flip mapMaybe ls (asVar >=> \l' -> + if NameSet.member l' det_vars then Nothing + else return l') = + implEndLifetimeRecM l' >>> + getPerm l >>>= \p' -> simplify1PermForDetVars det_vars l p' + -- If none of the above cases match but p has only determined free variables, -- just leave p as is simplify1PermForDetVars det_vars _ p From bb1122a7e93927b8ff0c111794d987caf8191947 Mon Sep 17 00:00:00 2001 From: Eddy Westbrook Date: Tue, 10 Aug 2021 15:00:49 -0700 Subject: [PATCH 26/28] whoops, fixed comments --- heapster-saw/src/Verifier/SAW/Heapster/Implication.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/heapster-saw/src/Verifier/SAW/Heapster/Implication.hs b/heapster-saw/src/Verifier/SAW/Heapster/Implication.hs index 5de774fb05..37325ad95c 100644 --- a/heapster-saw/src/Verifier/SAW/Heapster/Implication.hs +++ b/heapster-saw/src/Verifier/SAW/Heapster/Implication.hs @@ -3716,7 +3716,7 @@ implBeginLifetimeM = -- | End a lifetime, assuming the top of the stack is of the form -- --- > ps_in, l:lowned(ps_in -o ps_out) +-- > ps, ps_in, l:lowned(ps_in -o ps_out) -- -- Remove @l@ from any other @lowned@ permissions held by other variables. -- Recombine all the returned permissions @ps_out@ and @l:lfinished@ returned by From ef3efc26b5c59db064ef350a15395ebfce81dd49 Mon Sep 17 00:00:00 2001 From: Eddy Westbrook Date: Wed, 11 Aug 2021 10:26:24 -0700 Subject: [PATCH 27/28] retrigger the CI checks From 0900364192c73d4851650d7ba22ab798a5531f1a Mon Sep 17 00:00:00 2001 From: Eddy Westbrook Date: Wed, 11 Aug 2021 15:35:39 -0700 Subject: [PATCH 28/28] updated arrays.v with its new translation --- heapster-saw/examples/arrays.v | 202 ++++++++++++++++++++++----------- 1 file changed, 136 insertions(+), 66 deletions(-) diff --git a/heapster-saw/examples/arrays.v b/heapster-saw/examples/arrays.v index 895ce70f40..1ec817afc2 100644 --- a/heapster-saw/examples/arrays.v +++ b/heapster-saw/examples/arrays.v @@ -1,77 +1,147 @@ -From Coq Require Import Lists.List. -From Coq Require Import String. -From Coq Require Import Vectors.Vector. +(** Mandatory imports from saw-core-coq *) +From Coq Require Import Lists.List. +From Coq Require Import String. +From Coq Require Import Vectors.Vector. From CryptolToCoq Require Import SAWCoreScaffolding. From CryptolToCoq Require Import SAWCoreVectorsAsCoqVectors. +Import ListNotations. +(** Post-preamble section specified by you *) From CryptolToCoq Require Import SAWCorePrelude. -Import ListNotations. +(** Code generated by saw-core-coq *) Module arrays. -Definition contains0_rec___tuple_fun : @CompM.lrtTupleType (@CompM.LRT_Cons (@CompM.LRT_Fun (@SAWCorePrelude.bitvector 64) (fun (arg0 : @SAWCorePrelude.bitvector 64) => @CompM.LRT_Fun (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) (fun (perm0 : @SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) => @CompM.LRT_Fun (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) (fun (perm1 : @sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) => @CompM.LRT_Ret (prod (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) (prod (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) unit)))))) (@CompM.LRT_Nil)) := - @CompM.multiFixM (@CompM.LRT_Cons (@CompM.LRT_Fun (@SAWCorePrelude.bitvector 64) (fun (arg0 : @SAWCorePrelude.bitvector 64) => @CompM.LRT_Fun (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) (fun (perm0 : @SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) => @CompM.LRT_Fun (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) (fun (perm1 : @sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) => @CompM.LRT_Ret (prod (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) (prod (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) unit)))))) (@CompM.LRT_Nil)) (fun (contains0_rec_ : @CompM.lrtToType (@CompM.LRT_Fun (@SAWCorePrelude.bitvector 64) (fun (arg0 : @SAWCorePrelude.bitvector 64) => @CompM.LRT_Fun (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) (fun (perm0 : @SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) => @CompM.LRT_Fun (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) (fun (perm1 : @sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) => @CompM.LRT_Ret (prod (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) (prod (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) unit))))))) => pair (fun (e0 : @SAWCorePrelude.bitvector 64) (p0 : @SAWCorePrelude.BVVec 64 e0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) (p1 : @sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) => @CompM.letRecM (@CompM.LRT_Nil) (prod (@SAWCorePrelude.BVVec 64 e0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) (prod (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) unit)) tt (if @SAWCoreScaffolding.not (@SAWCorePrelude.bvEq 1 (if @SAWCoreVectorsAsCoqVectors.bvule 64 e0 (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) p1) then intToBv 1 (-1)%Z else intToBv 1 0%Z) (intToBv 1 0%Z)) then @returnM CompM _ (prod (@SAWCorePrelude.BVVec 64 e0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) (prod (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) unit)) (pair p0 (pair (@existT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit) (intToBv 64 0%Z) tt) tt)) else if @SAWCoreScaffolding.and (@SAWCoreVectorsAsCoqVectors.bvsle 64 (intToBv 64 0xf000000000000000%Z) (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) p1)) (@SAWCoreVectorsAsCoqVectors.bvsle 64 (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) p1) (intToBv 64 0xfffffffffffffff%Z)) then @SAWCorePrelude.maybe (@SAWCoreScaffolding.EqP (@SAWCoreScaffolding.Bool) (@SAWCoreVectorsAsCoqVectors.bvult 64 (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) p1) e0) (@SAWCoreScaffolding.true)) (CompM (prod (@SAWCorePrelude.BVVec 64 e0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) (prod (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) unit))) (@errorM CompM _ (prod (@SAWCorePrelude.BVVec 64 e0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) (prod (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) unit)) "ghost10 unit) p1) e0) (@SAWCoreScaffolding.true)) => if @SAWCoreScaffolding.not (@SAWCorePrelude.bvEq 1 (if @SAWCorePrelude.bvEq 64 (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) (@SAWCorePrelude.atBVVec 64 e0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) p0 (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) p1) ult_pf0)) (intToBv 64 0%Z) then intToBv 1 (-1)%Z else intToBv 1 0%Z) (intToBv 1 0%Z)) then @returnM CompM _ (prod (@SAWCorePrelude.BVVec 64 e0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) (prod (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) unit)) (pair (@SAWCorePrelude.adjustBVVec 64 e0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) p0 (fun (fld0 : @sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) => @existT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit) (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) (@SAWCorePrelude.atBVVec 64 e0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) p0 (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) p1) ult_pf0)) tt) (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) p1)) (pair (@existT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit) (intToBv 64 1%Z) tt) tt)) else @bindM CompM _ (prod (@SAWCorePrelude.BVVec 64 e0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) (prod (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) unit)) (prod (@SAWCorePrelude.BVVec 64 e0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) (prod (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) unit)) (contains0_rec_ e0 (@SAWCorePrelude.adjustBVVec 64 e0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) p0 (fun (fld0 : @sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) => @existT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit) (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) (@SAWCorePrelude.atBVVec 64 e0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) p0 (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) p1) ult_pf0)) tt) (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) p1)) (@existT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit) (@SAWCoreVectorsAsCoqVectors.bvAdd 64 (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) p1) (intToBv 64 1%Z)) tt)) (fun (call_ret_val : prod (@SAWCorePrelude.BVVec 64 e0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) (prod (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) unit)) => @returnM CompM _ (prod (@SAWCorePrelude.BVVec 64 e0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) (prod (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) unit)) (pair (SAWCoreScaffolding.fst call_ret_val) (pair (@existT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit) (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) (SAWCoreScaffolding.fst (SAWCoreScaffolding.snd call_ret_val))) tt) tt)))) (@SAWCorePrelude.bvultWithProof 64 (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) p1) e0) else @errorM CompM _ (prod (@SAWCorePrelude.BVVec 64 e0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) (prod (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) unit)) "Failed Assert at arrays.c:19:14"%string)) tt). - -Definition contains0_rec_ : @CompM.lrtToType (@CompM.LRT_Fun (@SAWCorePrelude.bitvector 64) (fun (arg0 : @SAWCorePrelude.bitvector 64) => @CompM.LRT_Fun (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) (fun (perm0 : @SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) => @CompM.LRT_Fun (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) (fun (perm1 : @sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) => @CompM.LRT_Ret (prod (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) (prod (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) unit)))))) := - SAWCoreScaffolding.fst (@contains0_rec___tuple_fun). - -Definition contains0__tuple_fun : @CompM.lrtTupleType (@CompM.LRT_Cons (@CompM.LRT_Fun (@SAWCorePrelude.bitvector 64) (fun (arg0 : @SAWCorePrelude.bitvector 64) => @CompM.LRT_Fun (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) (fun (perm0 : @SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) => @CompM.LRT_Ret (prod (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) (prod (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) unit))))) (@CompM.LRT_Nil)) := - @CompM.multiFixM (@CompM.LRT_Cons (@CompM.LRT_Fun (@SAWCorePrelude.bitvector 64) (fun (arg0 : @SAWCorePrelude.bitvector 64) => @CompM.LRT_Fun (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) (fun (perm0 : @SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) => @CompM.LRT_Ret (prod (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) (prod (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) unit))))) (@CompM.LRT_Nil)) (fun (contains0 : @CompM.lrtToType (@CompM.LRT_Fun (@SAWCorePrelude.bitvector 64) (fun (arg0 : @SAWCorePrelude.bitvector 64) => @CompM.LRT_Fun (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) (fun (perm0 : @SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) => @CompM.LRT_Ret (prod (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) (prod (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) unit)))))) => pair (fun (e0 : @SAWCorePrelude.bitvector 64) (p0 : @SAWCorePrelude.BVVec 64 e0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) => @CompM.letRecM (@CompM.LRT_Cons (@CompM.LRT_Fun (@SAWCorePrelude.bitvector 64) (fun (arg0 : @SAWCorePrelude.bitvector 64) => @CompM.LRT_Fun (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) (fun (p1 : @SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) => @CompM.LRT_Fun (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) (fun (p2 : @sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) => @CompM.LRT_Ret (prod (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) (prod (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) unit)))))) (@CompM.LRT_Nil)) (prod (@SAWCorePrelude.BVVec 64 e0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) (prod (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) unit)) (fun (f : @CompM.lrtToType (@CompM.LRT_Fun (@SAWCorePrelude.bitvector 64) (fun (arg0 : @SAWCorePrelude.bitvector 64) => @CompM.LRT_Fun (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) (fun (p1 : @SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) => @CompM.LRT_Fun (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) (fun (p2 : @sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) => @CompM.LRT_Ret (prod (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) (prod (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) unit))))))) => pair (fun (e1 : @SAWCorePrelude.bitvector 64) (p1 : @SAWCorePrelude.BVVec 64 e1 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) (p2 : @sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) => if @SAWCoreScaffolding.not (@SAWCorePrelude.bvEq 1 (if @SAWCoreVectorsAsCoqVectors.bvult 64 (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) p2) e1 then intToBv 1 (-1)%Z else intToBv 1 0%Z) (intToBv 1 0%Z)) then if @SAWCoreScaffolding.and (@SAWCoreVectorsAsCoqVectors.bvsle 64 (intToBv 64 0xf000000000000000%Z) (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) (@existT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit) (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) p2) tt))) (@SAWCoreVectorsAsCoqVectors.bvsle 64 (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) (@existT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit) (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) p2) tt)) (intToBv 64 0xfffffffffffffff%Z)) then @SAWCorePrelude.maybe (@SAWCoreScaffolding.EqP (@SAWCoreScaffolding.Bool) (@SAWCoreVectorsAsCoqVectors.bvult 64 (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) (@existT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit) (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) p2) tt)) e1) (@SAWCoreScaffolding.true)) (CompM (prod (@SAWCorePrelude.BVVec 64 e1 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) (prod (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) unit))) (@errorM CompM _ (prod (@SAWCorePrelude.BVVec 64 e1 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) (prod (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) unit)) "z15 unit) (@existT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit) (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) p2) tt)) e1) (@SAWCoreScaffolding.true)) => if @SAWCoreScaffolding.not (@SAWCorePrelude.bvEq 1 (if @SAWCorePrelude.bvEq 64 (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) (@SAWCorePrelude.atBVVec 64 e1 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) p1 (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) (@existT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit) (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) p2) tt)) ult_pf0)) (intToBv 64 0%Z) then intToBv 1 (-1)%Z else intToBv 1 0%Z) (intToBv 1 0%Z)) then @returnM CompM _ (prod (@SAWCorePrelude.BVVec 64 e1 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) (prod (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) unit)) (pair (@SAWCorePrelude.adjustBVVec 64 e1 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) p1 (fun (fld0 : @sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) => @existT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit) (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) (@existT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit) (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) (@SAWCorePrelude.atBVVec 64 e1 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) p1 (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) (@existT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit) (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) p2) tt)) ult_pf0)) tt)) tt) (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) (@existT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit) (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) p2) tt))) (pair (@existT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit) (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) (@existT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit) (intToBv 64 1%Z) tt)) tt) tt)) else f e1 (@SAWCorePrelude.adjustBVVec 64 e1 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) p1 (fun (fld0 : @sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) => @existT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit) (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) (@existT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit) (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) (@SAWCorePrelude.atBVVec 64 e1 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) p1 (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) (@existT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit) (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) p2) tt)) ult_pf0)) tt)) tt) (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) (@existT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit) (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) p2) tt))) (@existT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit) (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) (@existT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit) (@SAWCoreVectorsAsCoqVectors.bvAdd 64 (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) (@existT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit) (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) p2) tt)) (intToBv 64 1%Z)) tt)) tt)) (@SAWCorePrelude.bvultWithProof 64 (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) (@existT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit) (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) p2) tt)) e1) else @errorM CompM _ (prod (@SAWCorePrelude.BVVec 64 e1 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) (prod (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) unit)) "Failed Assert at arrays.c:29:9"%string else @returnM CompM _ (prod (@SAWCorePrelude.BVVec 64 e1 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) (prod (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) unit)) (pair p1 (pair (@existT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit) (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) (@existT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit) (intToBv 64 0%Z) tt)) tt) tt))) tt) (fun (f : @CompM.lrtToType (@CompM.LRT_Fun (@SAWCorePrelude.bitvector 64) (fun (arg0 : @SAWCorePrelude.bitvector 64) => @CompM.LRT_Fun (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) (fun (p1 : @SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) => @CompM.LRT_Fun (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) (fun (p2 : @sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) => @CompM.LRT_Ret (prod (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) (prod (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) unit))))))) => f e0 p0 (@existT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit) (intToBv 64 0%Z) tt))) tt). - -Definition contains0 : @CompM.lrtToType (@CompM.LRT_Fun (@SAWCorePrelude.bitvector 64) (fun (arg0 : @SAWCorePrelude.bitvector 64) => @CompM.LRT_Fun (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) (fun (perm0 : @SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) => @CompM.LRT_Ret (prod (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) (prod (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) unit))))) := - SAWCoreScaffolding.fst (@contains0__tuple_fun). - -Definition zero_array__tuple_fun : @CompM.lrtTupleType (@CompM.LRT_Cons (@CompM.LRT_Fun (@SAWCorePrelude.bitvector 64) (fun (arg0 : @SAWCorePrelude.bitvector 64) => @CompM.LRT_Fun (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) (fun (perm0 : @SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) => @CompM.LRT_Ret (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)))))) (@CompM.LRT_Nil)) := - @CompM.multiFixM (@CompM.LRT_Cons (@CompM.LRT_Fun (@SAWCorePrelude.bitvector 64) (fun (arg0 : @SAWCorePrelude.bitvector 64) => @CompM.LRT_Fun (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) (fun (perm0 : @SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) => @CompM.LRT_Ret (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)))))) (@CompM.LRT_Nil)) (fun (zero_array : @CompM.lrtToType (@CompM.LRT_Fun (@SAWCorePrelude.bitvector 64) (fun (arg0 : @SAWCorePrelude.bitvector 64) => @CompM.LRT_Fun (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) (fun (perm0 : @SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) => @CompM.LRT_Ret (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))))))) => pair (fun (e0 : @SAWCorePrelude.bitvector 64) (p0 : @SAWCorePrelude.BVVec 64 e0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) => @CompM.letRecM (@CompM.LRT_Cons (@CompM.LRT_Fun (@SAWCorePrelude.bitvector 64) (fun (arg0 : @SAWCorePrelude.bitvector 64) => @CompM.LRT_Fun (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) (fun (p1 : @SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) => @CompM.LRT_Fun (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) (fun (p2 : @sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) => @CompM.LRT_Ret (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))))))) (@CompM.LRT_Nil)) (@SAWCorePrelude.BVVec 64 e0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) (fun (f : @CompM.lrtToType (@CompM.LRT_Fun (@SAWCorePrelude.bitvector 64) (fun (arg0 : @SAWCorePrelude.bitvector 64) => @CompM.LRT_Fun (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) (fun (p1 : @SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) => @CompM.LRT_Fun (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) (fun (p2 : @sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) => @CompM.LRT_Ret (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)))))))) => pair (fun (e1 : @SAWCorePrelude.bitvector 64) (p1 : @SAWCorePrelude.BVVec 64 e1 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) (p2 : @sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) => if @SAWCoreScaffolding.not (@SAWCorePrelude.bvEq 1 (if @SAWCoreVectorsAsCoqVectors.bvult 64 (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) p2) e1 then intToBv 1 (-1)%Z else intToBv 1 0%Z) (intToBv 1 0%Z)) then if @SAWCoreScaffolding.and (@SAWCoreVectorsAsCoqVectors.bvsle 64 (intToBv 64 0xf000000000000000%Z) (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) (@existT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit) (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) p2) tt))) (@SAWCoreVectorsAsCoqVectors.bvsle 64 (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) (@existT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit) (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) p2) tt)) (intToBv 64 0xfffffffffffffff%Z)) then @SAWCorePrelude.maybe (@SAWCoreScaffolding.EqP (@SAWCoreScaffolding.Bool) (@SAWCoreVectorsAsCoqVectors.bvult 64 (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) (@existT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit) (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) p2) tt)) e1) (@SAWCoreScaffolding.true)) (CompM (@SAWCorePrelude.BVVec 64 e1 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)))) (@errorM CompM _ (@SAWCorePrelude.BVVec 64 e1 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) "z13 unit) (@existT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit) (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) p2) tt)) e1) (@SAWCoreScaffolding.true)) => f e1 (@SAWCorePrelude.adjustBVVec 64 e1 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) p1 (fun (fld0 : @sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) => @existT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit) (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) (@existT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit) (intToBv 64 0%Z) tt)) tt) (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) (@existT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit) (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) p2) tt))) (@existT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit) (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) (@existT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit) (@SAWCoreVectorsAsCoqVectors.bvAdd 64 (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) (@existT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit) (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) p2) tt)) (intToBv 64 1%Z)) tt)) tt)) (@SAWCorePrelude.bvultWithProof 64 (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) (@existT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit) (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) p2) tt)) e1) else @errorM CompM _ (@SAWCorePrelude.BVVec 64 e1 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) "Failed Assert at arrays.c:61:5"%string else @returnM CompM _ (@SAWCorePrelude.BVVec 64 e1 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) p1) tt) (fun (f : @CompM.lrtToType (@CompM.LRT_Fun (@SAWCorePrelude.bitvector 64) (fun (arg0 : @SAWCorePrelude.bitvector 64) => @CompM.LRT_Fun (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) (fun (p1 : @SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) => @CompM.LRT_Fun (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) (fun (p2 : @sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) => @CompM.LRT_Ret (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)))))))) => f e0 p0 (@existT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit) (intToBv 64 0%Z) tt))) tt). - -Definition zero_array : @CompM.lrtToType (@CompM.LRT_Fun (@SAWCorePrelude.bitvector 64) (fun (arg0 : @SAWCorePrelude.bitvector 64) => @CompM.LRT_Fun (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) (fun (perm0 : @SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) => @CompM.LRT_Ret (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)))))) := - SAWCoreScaffolding.fst (@zero_array__tuple_fun). - -Definition zero_array_from__tuple_fun : @CompM.lrtTupleType (@CompM.LRT_Cons (@CompM.LRT_Fun (@SAWCorePrelude.bitvector 64) (fun (arg0 : @SAWCorePrelude.bitvector 64) => @CompM.LRT_Fun (@SAWCorePrelude.bitvector 64) (fun (arg1 : @SAWCorePrelude.bitvector 64) => @CompM.LRT_Fun (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) (fun (perm0 : @SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) => @CompM.LRT_Ret (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))))))) (@CompM.LRT_Nil)) := - @CompM.multiFixM (@CompM.LRT_Cons (@CompM.LRT_Fun (@SAWCorePrelude.bitvector 64) (fun (arg0 : @SAWCorePrelude.bitvector 64) => @CompM.LRT_Fun (@SAWCorePrelude.bitvector 64) (fun (arg1 : @SAWCorePrelude.bitvector 64) => @CompM.LRT_Fun (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) (fun (perm0 : @SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) => @CompM.LRT_Ret (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))))))) (@CompM.LRT_Nil)) (fun (zero_array_from : @CompM.lrtToType (@CompM.LRT_Fun (@SAWCorePrelude.bitvector 64) (fun (arg0 : @SAWCorePrelude.bitvector 64) => @CompM.LRT_Fun (@SAWCorePrelude.bitvector 64) (fun (arg1 : @SAWCorePrelude.bitvector 64) => @CompM.LRT_Fun (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) (fun (perm0 : @SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) => @CompM.LRT_Ret (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)))))))) => pair (fun (e0 : @SAWCorePrelude.bitvector 64) (e1 : @SAWCorePrelude.bitvector 64) (p0 : @SAWCorePrelude.BVVec 64 e0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) => @CompM.letRecM (@CompM.LRT_Cons (@CompM.LRT_Fun (@SAWCorePrelude.bitvector 64) (fun (arg0 : @SAWCorePrelude.bitvector 64) => @CompM.LRT_Fun (@SAWCorePrelude.bitvector 64) (fun (arg1 : @SAWCorePrelude.bitvector 64) => @CompM.LRT_Fun (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) (fun (p1 : @SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) => @CompM.LRT_Fun (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) (fun (p2 : @sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) => @CompM.LRT_Ret (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)))))))) (@CompM.LRT_Nil)) (@SAWCorePrelude.BVVec 64 e0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) (fun (f : @CompM.lrtToType (@CompM.LRT_Fun (@SAWCorePrelude.bitvector 64) (fun (arg0 : @SAWCorePrelude.bitvector 64) => @CompM.LRT_Fun (@SAWCorePrelude.bitvector 64) (fun (arg1 : @SAWCorePrelude.bitvector 64) => @CompM.LRT_Fun (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) (fun (p1 : @SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) => @CompM.LRT_Fun (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) (fun (p2 : @sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) => @CompM.LRT_Ret (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))))))))) => pair (fun (e2 : @SAWCorePrelude.bitvector 64) (e3 : @SAWCorePrelude.bitvector 64) (p1 : @SAWCorePrelude.BVVec 64 e2 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) (p2 : @sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) => if @SAWCoreScaffolding.not (@SAWCorePrelude.bvEq 1 (if @SAWCoreVectorsAsCoqVectors.bvult 64 (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) p2) e2 then intToBv 1 (-1)%Z else intToBv 1 0%Z) (intToBv 1 0%Z)) then if @SAWCoreScaffolding.and (@SAWCoreVectorsAsCoqVectors.bvsle 64 (intToBv 64 0xf000000000000000%Z) (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) (@existT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit) (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) p2) tt))) (@SAWCoreVectorsAsCoqVectors.bvsle 64 (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) (@existT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit) (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) p2) tt)) (intToBv 64 0xfffffffffffffff%Z)) then @SAWCorePrelude.maybe (@SAWCoreScaffolding.EqP (@SAWCoreScaffolding.Bool) (@SAWCoreVectorsAsCoqVectors.bvult 64 (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) (@existT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit) (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) p2) tt)) e2) (@SAWCoreScaffolding.true)) (CompM (@SAWCorePrelude.BVVec 64 e2 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)))) (@errorM CompM _ (@SAWCorePrelude.BVVec 64 e2 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) "z15 unit) (@existT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit) (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) p2) tt)) e2) (@SAWCoreScaffolding.true)) => @errorM CompM _ (@SAWCorePrelude.BVVec 64 e2 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) "At arrays.c:67:3 (jump %9($0, $1, $2)) - Regs: $0 = local6, $1 = local7, $2 = local8 - Input perms: top1:true, top2:true, - top3:array(0, - exists z17. eq(LLVMword z17) ], - [(ghost14).0]) - *ptr((W,8*ghost14+0) |-> eq(ghost15)), - top4:eq(LLVMword top1), top5:exists z17. eq(LLVMword z17), - ghost10:llvmframe [local8:8, local7:8, local6:8], - local6:ptr((W,0) |-> eq(ghost11)), local7:ptr((W,0) |-> - eq(ghost12)), - local8:ptr((W,0) |-> eq(local9)), - local9:exists z17. eq(LLVMword z17), ghost11:eq(top3), - ghost12:eq(LLVMword top1), ghost14:true, - ghost15:exists z17. eq(LLVMword z17) - Could not prove: (z20, z19, z18, z17). - top1:true, top2:true, - top3:array(0, - exists z21. eq(LLVMword z21) ], - []), top4:eq(LLVMword top1), - top5:exists z21. eq(LLVMword z21), local6:ptr((W,0) |-> - eq(z19)), - local7:ptr((W,0) |-> eq(z18)), local8:ptr((W,0) |-> - eq(z17)), - z20:llvmframe [local8:8, local7:8, local6:8], z19:eq(top3), - z18:eq(top4), z17:eq(top5) - - proveEq: Could not prove z20 = (z24, z23, z22, z21). z18"%string) (@SAWCorePrelude.bvultWithProof 64 (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) (@existT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit) (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) p2) tt)) e2) else @errorM CompM _ (@SAWCorePrelude.BVVec 64 e2 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) "Failed Assert at arrays.c:68:5"%string else @returnM CompM _ (@SAWCorePrelude.BVVec 64 e2 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) p1) tt) (fun (f : @CompM.lrtToType (@CompM.LRT_Fun (@SAWCorePrelude.bitvector 64) (fun (arg0 : @SAWCorePrelude.bitvector 64) => @CompM.LRT_Fun (@SAWCorePrelude.bitvector 64) (fun (arg1 : @SAWCorePrelude.bitvector 64) => @CompM.LRT_Fun (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) (fun (p1 : @SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) => @CompM.LRT_Fun (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) (fun (p2 : @sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) => @CompM.LRT_Ret (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))))))))) => f e0 e1 p0 (@existT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit) e1 tt))) tt). - -Definition zero_array_from : @CompM.lrtToType (@CompM.LRT_Fun (@SAWCorePrelude.bitvector 64) (fun (arg0 : @SAWCorePrelude.bitvector 64) => @CompM.LRT_Fun (@SAWCorePrelude.bitvector 64) (fun (arg1 : @SAWCorePrelude.bitvector 64) => @CompM.LRT_Fun (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) (fun (perm0 : @SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) => @CompM.LRT_Ret (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))))))) := - SAWCoreScaffolding.fst (@zero_array_from__tuple_fun). - -Definition filter_and_sum_pos__tuple_fun : @CompM.lrtTupleType (@CompM.LRT_Cons (@CompM.LRT_Fun (@SAWCorePrelude.bitvector 64) (fun (arg0 : @SAWCorePrelude.bitvector 64) => @CompM.LRT_Fun (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) (fun (perm0 : @SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) => @CompM.LRT_Ret (prod (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) (prod (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) unit))))) (@CompM.LRT_Nil)) := - @CompM.multiFixM (@CompM.LRT_Cons (@CompM.LRT_Fun (@SAWCorePrelude.bitvector 64) (fun (arg0 : @SAWCorePrelude.bitvector 64) => @CompM.LRT_Fun (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) (fun (perm0 : @SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) => @CompM.LRT_Ret (prod (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) (prod (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) unit))))) (@CompM.LRT_Nil)) (fun (filter_and_sum_pos : @CompM.lrtToType (@CompM.LRT_Fun (@SAWCorePrelude.bitvector 64) (fun (arg0 : @SAWCorePrelude.bitvector 64) => @CompM.LRT_Fun (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) (fun (perm0 : @SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) => @CompM.LRT_Ret (prod (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) (prod (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) unit)))))) => pair (fun (e0 : @SAWCorePrelude.bitvector 64) (p0 : @SAWCorePrelude.BVVec 64 e0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) => @CompM.letRecM (@CompM.LRT_Cons (@CompM.LRT_Fun (@SAWCorePrelude.bitvector 64) (fun (arg0 : @SAWCorePrelude.bitvector 64) => @CompM.LRT_Fun (@SAWCorePrelude.bitvector 64) (fun (arg1 : @SAWCorePrelude.bitvector 64) => @CompM.LRT_Fun (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) (fun (p1 : @SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) => @CompM.LRT_Fun (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) (fun (p2 : @sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) => @CompM.LRT_Fun (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) (fun (p3 : @sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) => @CompM.LRT_Ret (prod (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) (prod (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) unit)))))))) (@CompM.LRT_Cons (@CompM.LRT_Fun (@SAWCorePrelude.bitvector 64) (fun (arg0 : @SAWCorePrelude.bitvector 64) => @CompM.LRT_Fun (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) (fun (p1 : @SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) => @CompM.LRT_Fun (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) (fun (p2 : @sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) => @CompM.LRT_Fun (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) (fun (p3 : @sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) => @CompM.LRT_Ret (prod (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) (prod (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) unit))))))) (@CompM.LRT_Nil))) (prod (@SAWCorePrelude.BVVec 64 e0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) (prod (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) unit)) (fun (f : @CompM.lrtToType (@CompM.LRT_Fun (@SAWCorePrelude.bitvector 64) (fun (arg0 : @SAWCorePrelude.bitvector 64) => @CompM.LRT_Fun (@SAWCorePrelude.bitvector 64) (fun (arg1 : @SAWCorePrelude.bitvector 64) => @CompM.LRT_Fun (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) (fun (p1 : @SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) => @CompM.LRT_Fun (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) (fun (p2 : @sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) => @CompM.LRT_Fun (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) (fun (p3 : @sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) => @CompM.LRT_Ret (prod (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) (prod (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) unit))))))))) (f1 : @CompM.lrtToType (@CompM.LRT_Fun (@SAWCorePrelude.bitvector 64) (fun (arg0 : @SAWCorePrelude.bitvector 64) => @CompM.LRT_Fun (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) (fun (p1 : @SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) => @CompM.LRT_Fun (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) (fun (p2 : @sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) => @CompM.LRT_Fun (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) (fun (p3 : @sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) => @CompM.LRT_Ret (prod (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) (prod (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) unit)))))))) => pair (fun (e1 : @SAWCorePrelude.bitvector 64) (e2 : @SAWCorePrelude.bitvector 64) (p1 : @SAWCorePrelude.BVVec 64 e1 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) (p2 : @sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) (p3 : @sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) => if @SAWCoreScaffolding.and (@SAWCoreVectorsAsCoqVectors.bvsle 64 (intToBv 64 0xf000000000000000%Z) e2) (@SAWCoreVectorsAsCoqVectors.bvsle 64 e2 (intToBv 64 0xfffffffffffffff%Z)) then f1 e1 (@SAWCorePrelude.adjustBVVec 64 e1 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) p1 (fun (fld0 : @sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) => @existT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit) (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) (@existT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit) (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) p3) tt)) tt) e2) (@existT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit) (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) (@existT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit) (@SAWCoreVectorsAsCoqVectors.bvAdd 64 (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) p2) (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) p3)) tt)) tt) (@existT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit) (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) (@existT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit) (@SAWCoreVectorsAsCoqVectors.bvAdd 64 e2 (intToBv 64 1%Z)) tt)) tt) else @errorM CompM _ (prod (@SAWCorePrelude.BVVec 64 e1 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) (prod (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) unit)) "Failed Assert at arrays.c:80:12"%string) (pair (fun (e1 : @SAWCorePrelude.bitvector 64) (p1 : @SAWCorePrelude.BVVec 64 e1 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) (p2 : @sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) (p3 : @sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) => if @SAWCoreScaffolding.not (@SAWCorePrelude.bvEq 1 (if @SAWCoreVectorsAsCoqVectors.bvult 64 (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) p3) e1 then intToBv 1 (-1)%Z else intToBv 1 0%Z) (intToBv 1 0%Z)) then if @SAWCoreScaffolding.and (@SAWCoreVectorsAsCoqVectors.bvsle 64 (intToBv 64 0xf000000000000000%Z) (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) (@existT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit) (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) p3) tt))) (@SAWCoreVectorsAsCoqVectors.bvsle 64 (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) (@existT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit) (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) p3) tt)) (intToBv 64 0xfffffffffffffff%Z)) then @SAWCorePrelude.maybe (@SAWCoreScaffolding.EqP (@SAWCoreScaffolding.Bool) (@SAWCoreVectorsAsCoqVectors.bvult 64 (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) (@existT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit) (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) p3) tt)) e1) (@SAWCoreScaffolding.true)) (CompM (prod (@SAWCorePrelude.BVVec 64 e1 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) (prod (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) unit))) (@errorM CompM _ (prod (@SAWCorePrelude.BVVec 64 e1 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) (prod (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) unit)) "z15 unit) (@existT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit) (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) p3) tt)) e1) (@SAWCoreScaffolding.true)) => if @SAWCoreScaffolding.not (@SAWCorePrelude.bvEq 1 (if @SAWCoreVectorsAsCoqVectors.bvslt 64 (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) (@SAWCorePrelude.atBVVec 64 e1 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) p1 (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) (@existT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit) (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) p3) tt)) ult_pf0)) (intToBv 64 0%Z) then intToBv 1 (-1)%Z else intToBv 1 0%Z) (intToBv 1 0%Z)) then if @SAWCoreScaffolding.and (@SAWCoreVectorsAsCoqVectors.bvsle 64 (intToBv 64 0xf000000000000000%Z) (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) (@existT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit) (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) p3) tt))) (@SAWCoreVectorsAsCoqVectors.bvsle 64 (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) (@existT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit) (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) p3) tt)) (intToBv 64 0xfffffffffffffff%Z)) then f e1 (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) (@existT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit) (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) p3) tt)) p1 (@existT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit) (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) p2) tt) (@existT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit) (intToBv 64 0%Z) tt) else @errorM CompM _ (prod (@SAWCorePrelude.BVVec 64 e1 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) (prod (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) unit)) "Failed Assert at arrays.c:78:7"%string else f e1 (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) (@existT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit) (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) p3) tt)) p1 p2 (@existT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit) (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) (@SAWCorePrelude.atBVVec 64 e1 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) p1 (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) (@existT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit) (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) p3) tt)) ult_pf0)) tt)) (@SAWCorePrelude.bvultWithProof 64 (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) (@existT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit) (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) p3) tt)) e1) else @errorM CompM _ (prod (@SAWCorePrelude.BVVec 64 e1 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) (prod (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) unit)) "Failed Assert at arrays.c:77:9"%string else @returnM CompM _ (prod (@SAWCorePrelude.BVVec 64 e1 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) (prod (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) unit)) (pair p1 (pair (@existT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit) (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) p2) tt) tt))) tt)) (fun (f : @CompM.lrtToType (@CompM.LRT_Fun (@SAWCorePrelude.bitvector 64) (fun (arg0 : @SAWCorePrelude.bitvector 64) => @CompM.LRT_Fun (@SAWCorePrelude.bitvector 64) (fun (arg1 : @SAWCorePrelude.bitvector 64) => @CompM.LRT_Fun (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) (fun (p1 : @SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) => @CompM.LRT_Fun (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) (fun (p2 : @sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) => @CompM.LRT_Fun (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) (fun (p3 : @sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) => @CompM.LRT_Ret (prod (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) (prod (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) unit))))))))) (f1 : @CompM.lrtToType (@CompM.LRT_Fun (@SAWCorePrelude.bitvector 64) (fun (arg0 : @SAWCorePrelude.bitvector 64) => @CompM.LRT_Fun (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) (fun (p1 : @SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) => @CompM.LRT_Fun (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) (fun (p2 : @sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) => @CompM.LRT_Fun (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) (fun (p3 : @sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) => @CompM.LRT_Ret (prod (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) (prod (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) unit)))))))) => f1 e0 p0 (@existT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit) (intToBv 64 0%Z) tt) (@existT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit) (intToBv 64 0%Z) tt))) tt). - -Definition filter_and_sum_pos : @CompM.lrtToType (@CompM.LRT_Fun (@SAWCorePrelude.bitvector 64) (fun (arg0 : @SAWCorePrelude.bitvector 64) => @CompM.LRT_Fun (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) (fun (perm0 : @SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) => @CompM.LRT_Ret (prod (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) (prod (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) unit))))) := - SAWCoreScaffolding.fst (@filter_and_sum_pos__tuple_fun). - -Definition sum_2d__tuple_fun : @CompM.lrtTupleType (@CompM.LRT_Cons (@CompM.LRT_Fun (@SAWCorePrelude.bitvector 64) (fun (arg0 : @SAWCorePrelude.bitvector 64) => @CompM.LRT_Fun (@SAWCorePrelude.bitvector 64) (fun (arg1 : @SAWCorePrelude.bitvector 64) => @CompM.LRT_Fun (@SAWCorePrelude.BVVec 64 arg0 (@SAWCorePrelude.BVVec 64 arg1 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)))) (fun (perm0 : @SAWCorePrelude.BVVec 64 arg0 (@SAWCorePrelude.BVVec 64 arg1 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)))) => @CompM.LRT_Ret (prod (@SAWCorePrelude.BVVec 64 arg0 (@SAWCorePrelude.BVVec 64 arg1 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)))) (prod (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) unit)))))) (@CompM.LRT_Nil)) := - @CompM.multiFixM (@CompM.LRT_Cons (@CompM.LRT_Fun (@SAWCorePrelude.bitvector 64) (fun (arg0 : @SAWCorePrelude.bitvector 64) => @CompM.LRT_Fun (@SAWCorePrelude.bitvector 64) (fun (arg1 : @SAWCorePrelude.bitvector 64) => @CompM.LRT_Fun (@SAWCorePrelude.BVVec 64 arg0 (@SAWCorePrelude.BVVec 64 arg1 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)))) (fun (perm0 : @SAWCorePrelude.BVVec 64 arg0 (@SAWCorePrelude.BVVec 64 arg1 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)))) => @CompM.LRT_Ret (prod (@SAWCorePrelude.BVVec 64 arg0 (@SAWCorePrelude.BVVec 64 arg1 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)))) (prod (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) unit)))))) (@CompM.LRT_Nil)) (fun (sum_2d : @CompM.lrtToType (@CompM.LRT_Fun (@SAWCorePrelude.bitvector 64) (fun (arg0 : @SAWCorePrelude.bitvector 64) => @CompM.LRT_Fun (@SAWCorePrelude.bitvector 64) (fun (arg1 : @SAWCorePrelude.bitvector 64) => @CompM.LRT_Fun (@SAWCorePrelude.BVVec 64 arg0 (@SAWCorePrelude.BVVec 64 arg1 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)))) (fun (perm0 : @SAWCorePrelude.BVVec 64 arg0 (@SAWCorePrelude.BVVec 64 arg1 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)))) => @CompM.LRT_Ret (prod (@SAWCorePrelude.BVVec 64 arg0 (@SAWCorePrelude.BVVec 64 arg1 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)))) (prod (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) unit))))))) => pair (fun (e0 : @SAWCorePrelude.bitvector 64) (e1 : @SAWCorePrelude.bitvector 64) (p0 : @SAWCorePrelude.BVVec 64 e0 (@SAWCorePrelude.BVVec 64 e1 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)))) => @CompM.letRecM (@CompM.LRT_Cons (@CompM.LRT_Fun (@SAWCorePrelude.bitvector 64) (fun (arg0 : @SAWCorePrelude.bitvector 64) => @CompM.LRT_Fun (@SAWCorePrelude.bitvector 64) (fun (arg1 : @SAWCorePrelude.bitvector 64) => @CompM.LRT_Fun (@SAWCorePrelude.BVVec 64 arg0 (@SAWCorePrelude.BVVec 64 arg1 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)))) (fun (p1 : @SAWCorePrelude.BVVec 64 arg0 (@SAWCorePrelude.BVVec 64 arg1 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)))) => @CompM.LRT_Fun (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) (fun (p2 : @sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) => @CompM.LRT_Fun (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) (fun (p3 : @sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) => @CompM.LRT_Fun (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) (fun (p4 : @sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) => @CompM.LRT_Ret (prod (@SAWCorePrelude.BVVec 64 arg0 (@SAWCorePrelude.BVVec 64 arg1 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)))) (prod (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) unit))))))))) (@CompM.LRT_Cons (@CompM.LRT_Fun (@SAWCorePrelude.bitvector 64) (fun (arg0 : @SAWCorePrelude.bitvector 64) => @CompM.LRT_Fun (@SAWCorePrelude.bitvector 64) (fun (arg1 : @SAWCorePrelude.bitvector 64) => @CompM.LRT_Fun (@SAWCorePrelude.BVVec 64 arg0 (@SAWCorePrelude.BVVec 64 arg1 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)))) (fun (p1 : @SAWCorePrelude.BVVec 64 arg0 (@SAWCorePrelude.BVVec 64 arg1 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)))) => @CompM.LRT_Fun (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) (fun (p2 : @sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) => @CompM.LRT_Fun (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) (fun (p3 : @sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) => @CompM.LRT_Ret (prod (@SAWCorePrelude.BVVec 64 arg0 (@SAWCorePrelude.BVVec 64 arg1 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)))) (prod (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) unit)))))))) (@CompM.LRT_Nil))) (prod (@SAWCorePrelude.BVVec 64 e0 (@SAWCorePrelude.BVVec 64 e1 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)))) (prod (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) unit)) (fun (f : @CompM.lrtToType (@CompM.LRT_Fun (@SAWCorePrelude.bitvector 64) (fun (arg0 : @SAWCorePrelude.bitvector 64) => @CompM.LRT_Fun (@SAWCorePrelude.bitvector 64) (fun (arg1 : @SAWCorePrelude.bitvector 64) => @CompM.LRT_Fun (@SAWCorePrelude.BVVec 64 arg0 (@SAWCorePrelude.BVVec 64 arg1 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)))) (fun (p1 : @SAWCorePrelude.BVVec 64 arg0 (@SAWCorePrelude.BVVec 64 arg1 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)))) => @CompM.LRT_Fun (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) (fun (p2 : @sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) => @CompM.LRT_Fun (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) (fun (p3 : @sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) => @CompM.LRT_Fun (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) (fun (p4 : @sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) => @CompM.LRT_Ret (prod (@SAWCorePrelude.BVVec 64 arg0 (@SAWCorePrelude.BVVec 64 arg1 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)))) (prod (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) unit)))))))))) (f1 : @CompM.lrtToType (@CompM.LRT_Fun (@SAWCorePrelude.bitvector 64) (fun (arg0 : @SAWCorePrelude.bitvector 64) => @CompM.LRT_Fun (@SAWCorePrelude.bitvector 64) (fun (arg1 : @SAWCorePrelude.bitvector 64) => @CompM.LRT_Fun (@SAWCorePrelude.BVVec 64 arg0 (@SAWCorePrelude.BVVec 64 arg1 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)))) (fun (p1 : @SAWCorePrelude.BVVec 64 arg0 (@SAWCorePrelude.BVVec 64 arg1 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)))) => @CompM.LRT_Fun (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) (fun (p2 : @sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) => @CompM.LRT_Fun (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) (fun (p3 : @sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) => @CompM.LRT_Ret (prod (@SAWCorePrelude.BVVec 64 arg0 (@SAWCorePrelude.BVVec 64 arg1 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)))) (prod (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) unit))))))))) => pair (fun (e2 : @SAWCorePrelude.bitvector 64) (e3 : @SAWCorePrelude.bitvector 64) (p1 : @SAWCorePrelude.BVVec 64 e2 (@SAWCorePrelude.BVVec 64 e3 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)))) (p2 : @sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) (p3 : @sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) (p4 : @sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) => if @SAWCoreScaffolding.not (@SAWCorePrelude.bvEq 1 (if @SAWCoreVectorsAsCoqVectors.bvult 64 (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) p4) e3 then intToBv 1 (-1)%Z else intToBv 1 0%Z) (intToBv 1 0%Z)) then if @SAWCoreScaffolding.and (@SAWCoreVectorsAsCoqVectors.bvsle 64 (intToBv 64 0xf000000000000000%Z) (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) p3)) (@SAWCoreVectorsAsCoqVectors.bvsle 64 (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) p3) (intToBv 64 0xfffffffffffffff%Z)) then @SAWCorePrelude.maybe (@SAWCoreScaffolding.EqP (@SAWCoreScaffolding.Bool) (@SAWCoreVectorsAsCoqVectors.bvult 64 (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) p3) e2) (@SAWCoreScaffolding.true)) (CompM (prod (@SAWCorePrelude.BVVec 64 e2 (@SAWCorePrelude.BVVec 64 e3 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)))) (prod (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) unit))) (@errorM CompM _ (prod (@SAWCorePrelude.BVVec 64 e2 (@SAWCorePrelude.BVVec 64 e3 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)))) (prod (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) unit)) "z21 unit) p3) e2) (@SAWCoreScaffolding.true)) => if @SAWCoreScaffolding.and (@SAWCoreVectorsAsCoqVectors.bvsle 64 (intToBv 64 0xf000000000000000%Z) (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) (@existT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit) (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) p4) tt))) (@SAWCoreVectorsAsCoqVectors.bvsle 64 (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) (@existT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit) (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) p4) tt)) (intToBv 64 0xfffffffffffffff%Z)) then @SAWCorePrelude.maybe (@SAWCoreScaffolding.EqP (@SAWCoreScaffolding.Bool) (@SAWCoreVectorsAsCoqVectors.bvult 64 (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) (@existT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit) (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) p4) tt)) e3) (@SAWCoreScaffolding.true)) (CompM (prod (@SAWCorePrelude.BVVec 64 e2 (@SAWCorePrelude.BVVec 64 e3 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)))) (prod (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) unit))) (@errorM CompM _ (prod (@SAWCorePrelude.BVVec 64 e2 (@SAWCorePrelude.BVVec 64 e3 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)))) (prod (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) unit)) "z40 unit) (@existT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit) (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) p4) tt)) e3) (@SAWCoreScaffolding.true)) => f e2 e3 (@SAWCorePrelude.adjustBVVec 64 e2 (@SAWCorePrelude.BVVec 64 e3 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) p1 (fun (fld0 : @SAWCorePrelude.BVVec 64 e3 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) => @SAWCorePrelude.adjustBVVec 64 e3 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) (@SAWCorePrelude.atBVVec 64 e2 (@SAWCorePrelude.BVVec 64 e3 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) p1 (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) p3) ult_pf0) (fun (fld1 : @sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) => @existT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit) (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) (@existT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit) (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) (@SAWCorePrelude.atBVVec 64 e3 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) (@SAWCorePrelude.atBVVec 64 e2 (@SAWCorePrelude.BVVec 64 e3 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) p1 (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) p3) ult_pf0) (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) (@existT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit) (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) p4) tt)) ult_pf1)) tt)) tt) (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) (@existT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit) (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) p4) tt))) (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) p3)) (@existT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit) (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) (@existT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit) (@SAWCoreVectorsAsCoqVectors.bvAdd 64 (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) p2) (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) (@SAWCorePrelude.atBVVec 64 e3 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) (@SAWCorePrelude.atBVVec 64 e2 (@SAWCorePrelude.BVVec 64 e3 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit))) p1 (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) p3) ult_pf0) (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) (@existT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit) (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) p4) tt)) ult_pf1))) tt)) tt) (@existT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit) (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) p3) tt) (@existT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit) (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) (@existT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit) (@SAWCoreVectorsAsCoqVectors.bvAdd 64 (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) (@existT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit) (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) p4) tt)) (intToBv 64 1%Z)) tt)) tt)) (@SAWCorePrelude.bvultWithProof 64 (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) (@existT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit) (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) p4) tt)) e3) else @errorM CompM _ (prod (@SAWCorePrelude.BVVec 64 e2 (@SAWCorePrelude.BVVec 64 e3 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)))) (prod (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) unit)) "Failed Assert at arrays.c:89:14"%string) (@SAWCorePrelude.bvultWithProof 64 (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) p3) e2) else @errorM CompM _ (prod (@SAWCorePrelude.BVVec 64 e2 (@SAWCorePrelude.BVVec 64 e3 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)))) (prod (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) unit)) "Failed Assert at arrays.c:89:14"%string else f1 e2 e3 p1 (@existT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit) (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) p2) tt) (@existT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit) (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) (@existT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit) (@SAWCoreVectorsAsCoqVectors.bvAdd 64 (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) p3) (intToBv 64 1%Z)) tt)) tt)) (pair (fun (e2 : @SAWCorePrelude.bitvector 64) (e3 : @SAWCorePrelude.bitvector 64) (p1 : @SAWCorePrelude.BVVec 64 e2 (@SAWCorePrelude.BVVec 64 e3 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)))) (p2 : @sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) (p3 : @sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) => if @SAWCoreScaffolding.not (@SAWCorePrelude.bvEq 1 (if @SAWCoreVectorsAsCoqVectors.bvult 64 (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) p3) e2 then intToBv 1 (-1)%Z else intToBv 1 0%Z) (intToBv 1 0%Z)) then f e2 e3 p1 p2 (@existT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit) (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) p3) tt) (@existT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit) (intToBv 64 0%Z) tt) else @returnM CompM _ (prod (@SAWCorePrelude.BVVec 64 e2 (@SAWCorePrelude.BVVec 64 e3 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)))) (prod (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) unit)) (pair p1 (pair (@existT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit) (@projT1 (@SAWCorePrelude.bitvector 64) (fun (x_elimEx0 : @SAWCorePrelude.bitvector 64) => unit) p2) tt) tt))) tt)) (fun (f : @CompM.lrtToType (@CompM.LRT_Fun (@SAWCorePrelude.bitvector 64) (fun (arg0 : @SAWCorePrelude.bitvector 64) => @CompM.LRT_Fun (@SAWCorePrelude.bitvector 64) (fun (arg1 : @SAWCorePrelude.bitvector 64) => @CompM.LRT_Fun (@SAWCorePrelude.BVVec 64 arg0 (@SAWCorePrelude.BVVec 64 arg1 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)))) (fun (p1 : @SAWCorePrelude.BVVec 64 arg0 (@SAWCorePrelude.BVVec 64 arg1 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)))) => @CompM.LRT_Fun (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) (fun (p2 : @sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) => @CompM.LRT_Fun (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) (fun (p3 : @sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) => @CompM.LRT_Fun (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) (fun (p4 : @sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) => @CompM.LRT_Ret (prod (@SAWCorePrelude.BVVec 64 arg0 (@SAWCorePrelude.BVVec 64 arg1 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)))) (prod (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) unit)))))))))) (f1 : @CompM.lrtToType (@CompM.LRT_Fun (@SAWCorePrelude.bitvector 64) (fun (arg0 : @SAWCorePrelude.bitvector 64) => @CompM.LRT_Fun (@SAWCorePrelude.bitvector 64) (fun (arg1 : @SAWCorePrelude.bitvector 64) => @CompM.LRT_Fun (@SAWCorePrelude.BVVec 64 arg0 (@SAWCorePrelude.BVVec 64 arg1 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)))) (fun (p1 : @SAWCorePrelude.BVVec 64 arg0 (@SAWCorePrelude.BVVec 64 arg1 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)))) => @CompM.LRT_Fun (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) (fun (p2 : @sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) => @CompM.LRT_Fun (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) (fun (p3 : @sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) => @CompM.LRT_Ret (prod (@SAWCorePrelude.BVVec 64 arg0 (@SAWCorePrelude.BVVec 64 arg1 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)))) (prod (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) unit))))))))) => f1 e0 e1 p0 (@existT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit) (intToBv 64 0%Z) tt) (@existT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit) (intToBv 64 0%Z) tt))) tt). - -Definition sum_2d : @CompM.lrtToType (@CompM.LRT_Fun (@SAWCorePrelude.bitvector 64) (fun (arg0 : @SAWCorePrelude.bitvector 64) => @CompM.LRT_Fun (@SAWCorePrelude.bitvector 64) (fun (arg1 : @SAWCorePrelude.bitvector 64) => @CompM.LRT_Fun (@SAWCorePrelude.BVVec 64 arg0 (@SAWCorePrelude.BVVec 64 arg1 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)))) (fun (perm0 : @SAWCorePrelude.BVVec 64 arg0 (@SAWCorePrelude.BVVec 64 arg1 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)))) => @CompM.LRT_Ret (prod (@SAWCorePrelude.BVVec 64 arg0 (@SAWCorePrelude.BVVec 64 arg1 (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)))) (prod (@sigT (@SAWCorePrelude.bitvector 64) (fun (x_ex0 : @SAWCorePrelude.bitvector 64) => unit)) unit)))))) := - SAWCoreScaffolding.fst (@sum_2d__tuple_fun). +Definition contains0_rec___tuple_fun : @CompM.lrtTupleType (@CompM.LRT_Cons (@CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) (fun (perm0 : @SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) => @CompM.LRT_Fun (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)) (fun (perm1 : @sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)) => @CompM.LRT_Ret (prod (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) (prod (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)) unit)))))) (@CompM.LRT_Nil)) := + @CompM.multiFixM (@CompM.LRT_Cons (@CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) (fun (perm0 : @SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) => @CompM.LRT_Fun (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)) (fun (perm1 : @sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)) => @CompM.LRT_Ret (prod (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) (prod (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)) unit)))))) (@CompM.LRT_Nil)) (fun (contains0_rec_ : @CompM.lrtToType (@CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) (fun (perm0 : @SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) => @CompM.LRT_Fun (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)) (fun (perm1 : @sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)) => @CompM.LRT_Ret (prod (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) (prod (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)) unit))))))) => pair (fun (e0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (p0 : @SAWCorePrelude.BVVec 64 e0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) (p1 : @sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)) => @CompM.letRecM (@CompM.LRT_Nil) (prod (@SAWCorePrelude.BVVec 64 e0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) (prod (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)) unit)) tt (if @SAWCoreScaffolding.not (@SAWCorePrelude.bvEq 1 (if @SAWCoreVectorsAsCoqVectors.bvule 64 e0 (@projT1 (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_elimEx0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit) p1) then intToBv 1 (-1)%Z else intToBv 1 0%Z) (intToBv 1 0%Z)) then @returnM CompM _ (prod (@SAWCorePrelude.BVVec 64 e0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) (prod (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)) unit)) (pair p0 (pair (@existT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit) (intToBv 64 0%Z) tt) tt)) else if @SAWCoreScaffolding.and (@SAWCoreVectorsAsCoqVectors.bvsle 64 (intToBv 64 0xf000000000000000%Z) (@projT1 (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_elimEx0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit) p1)) (@SAWCoreVectorsAsCoqVectors.bvsle 64 (@projT1 (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_elimEx0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit) p1) (intToBv 64 0xfffffffffffffff%Z)) then @SAWCorePrelude.maybe (@SAWCoreScaffolding.Eq (@SAWCoreScaffolding.Bool) (@SAWCoreVectorsAsCoqVectors.bvult 64 (@projT1 (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_elimEx0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit) p1) e0) (@SAWCoreScaffolding.true)) (CompM (prod (@SAWCorePrelude.BVVec 64 e0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) (prod (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)) unit))) (@errorM CompM _ (prod (@SAWCorePrelude.BVVec 64 e0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) (prod (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)) unit)) "ghost_bv unit) p1) e0) (@SAWCoreScaffolding.true)) => if @SAWCoreScaffolding.not (@SAWCorePrelude.bvEq 1 (if @SAWCorePrelude.bvEq 64 (@projT1 (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_elimEx0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit) (@SAWCorePrelude.atBVVec 64 e0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)) p0 (@projT1 (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_elimEx0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit) p1) ult_pf0)) (intToBv 64 0%Z) then intToBv 1 (-1)%Z else intToBv 1 0%Z) (intToBv 1 0%Z)) then @returnM CompM _ (prod (@SAWCorePrelude.BVVec 64 e0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) (prod (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)) unit)) (pair (@SAWCorePrelude.adjustBVVec 64 e0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)) p0 (fun (fld0 : @sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)) => @existT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit) (@projT1 (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_elimEx0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit) (@SAWCorePrelude.atBVVec 64 e0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)) p0 (@projT1 (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_elimEx0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit) p1) ult_pf0)) tt) (@projT1 (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_elimEx0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit) p1)) (pair (@existT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit) (intToBv 64 1%Z) tt) tt)) else @bindM CompM _ (prod (@SAWCorePrelude.BVVec 64 e0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) (prod (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)) unit)) (prod (@SAWCorePrelude.BVVec 64 e0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) (prod (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)) unit)) (contains0_rec_ e0 (@SAWCorePrelude.adjustBVVec 64 e0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)) p0 (fun (fld0 : @sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)) => @existT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit) (@projT1 (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_elimEx0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit) (@SAWCorePrelude.atBVVec 64 e0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)) p0 (@projT1 (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_elimEx0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit) p1) ult_pf0)) tt) (@projT1 (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_elimEx0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit) p1)) (@existT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit) (@SAWCoreVectorsAsCoqVectors.bvAdd 64 (@projT1 (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_elimEx0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit) p1) (intToBv 64 1%Z)) tt)) (fun (call_ret_val : prod (@SAWCorePrelude.BVVec 64 e0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) (prod (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)) unit)) => @returnM CompM _ (prod (@SAWCorePrelude.BVVec 64 e0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) (prod (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)) unit)) (pair (SAWCoreScaffolding.fst call_ret_val) (pair (@existT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit) (@projT1 (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_elimEx0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit) (SAWCoreScaffolding.fst (SAWCoreScaffolding.snd call_ret_val))) tt) tt)))) (@SAWCorePrelude.bvultWithProof 64 (@projT1 (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_elimEx0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit) p1) e0) else @errorM CompM _ (prod (@SAWCorePrelude.BVVec 64 e0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) (prod (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)) unit)) "Failed Assert at arrays.c:19:14"%string)) tt). + +Definition contains0_rec_ : @CompM.lrtToType (@CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) (fun (perm0 : @SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) => @CompM.LRT_Fun (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)) (fun (perm1 : @sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)) => @CompM.LRT_Ret (prod (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) (prod (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)) unit)))))) := + SAWCoreScaffolding.fst contains0_rec___tuple_fun. + +Definition contains0__tuple_fun : @CompM.lrtTupleType (@CompM.LRT_Cons (@CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) (fun (perm0 : @SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) => @CompM.LRT_Ret (prod (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) (prod (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)) unit))))) (@CompM.LRT_Nil)) := + @CompM.multiFixM (@CompM.LRT_Cons (@CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) (fun (perm0 : @SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) => @CompM.LRT_Ret (prod (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) (prod (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)) unit))))) (@CompM.LRT_Nil)) (fun (contains0 : @CompM.lrtToType (@CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) (fun (perm0 : @SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) => @CompM.LRT_Ret (prod (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) (prod (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)) unit)))))) => pair (fun (e0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (p0 : @SAWCorePrelude.BVVec 64 e0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) => @CompM.letRecM (@CompM.LRT_Cons (@CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg1 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) (fun (p1 : @SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) => @CompM.LRT_Fun unit (fun (p2 : unit) => @CompM.LRT_Fun unit (fun (p3 : unit) => @CompM.LRT_Fun unit (fun (p4 : unit) => @CompM.LRT_Ret (prod (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) (prod (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)) unit))))))))) (@CompM.LRT_Nil)) (prod (@SAWCorePrelude.BVVec 64 e0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) (prod (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)) unit)) (fun (f : @CompM.lrtToType (@CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg1 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) (fun (p1 : @SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) => @CompM.LRT_Fun unit (fun (p2 : unit) => @CompM.LRT_Fun unit (fun (p3 : unit) => @CompM.LRT_Fun unit (fun (p4 : unit) => @CompM.LRT_Ret (prod (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) (prod (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)) unit)))))))))) => pair (fun (e1 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (e2 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (p1 : @SAWCorePrelude.BVVec 64 e1 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) (p2 : unit) (p3 : unit) (p4 : unit) => if @SAWCoreScaffolding.not (@SAWCorePrelude.bvEq 1 (if @SAWCoreVectorsAsCoqVectors.bvult 64 e2 e1 then intToBv 1 (-1)%Z else intToBv 1 0%Z) (intToBv 1 0%Z)) then if @SAWCoreScaffolding.and (@SAWCoreVectorsAsCoqVectors.bvsle 64 (intToBv 64 0xf000000000000000%Z) e2) (@SAWCoreVectorsAsCoqVectors.bvsle 64 e2 (intToBv 64 0xfffffffffffffff%Z)) then @SAWCorePrelude.maybe (@SAWCoreScaffolding.Eq (@SAWCoreScaffolding.Bool) (@SAWCoreVectorsAsCoqVectors.bvult 64 e2 e1) (@SAWCoreScaffolding.true)) (CompM (prod (@SAWCorePrelude.BVVec 64 e1 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) (prod (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)) unit))) (@errorM CompM _ (prod (@SAWCorePrelude.BVVec 64 e1 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) (prod (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)) unit)) "ghost_bv if @SAWCoreScaffolding.not (@SAWCorePrelude.bvEq 1 (if @SAWCorePrelude.bvEq 64 (@projT1 (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_elimEx0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit) (@SAWCorePrelude.atBVVec 64 e1 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)) p1 e2 ult_pf0)) (intToBv 64 0%Z) then intToBv 1 (-1)%Z else intToBv 1 0%Z) (intToBv 1 0%Z)) then @returnM CompM _ (prod (@SAWCorePrelude.BVVec 64 e1 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) (prod (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)) unit)) (pair (@SAWCorePrelude.adjustBVVec 64 e1 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)) p1 (fun (fld0 : @sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)) => @existT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit) (@projT1 (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_elimEx0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit) (@SAWCorePrelude.atBVVec 64 e1 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)) p1 e2 ult_pf0)) tt) e2) (pair (@existT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit) (intToBv 64 1%Z) tt) tt)) else f e1 (@SAWCoreVectorsAsCoqVectors.bvAdd 64 e2 (intToBv 64 1%Z)) (@SAWCorePrelude.adjustBVVec 64 e1 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)) p1 (fun (fld0 : @sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)) => @existT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit) (@projT1 (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_elimEx0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit) (@SAWCorePrelude.atBVVec 64 e1 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)) p1 e2 ult_pf0)) tt) e2) tt tt tt) (@SAWCorePrelude.bvultWithProof 64 e2 e1) else @errorM CompM _ (prod (@SAWCorePrelude.BVVec 64 e1 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) (prod (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)) unit)) "Failed Assert at arrays.c:29:9"%string else @returnM CompM _ (prod (@SAWCorePrelude.BVVec 64 e1 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) (prod (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)) unit)) (pair p1 (pair (@existT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit) (intToBv 64 0%Z) tt) tt))) tt) (fun (f : @CompM.lrtToType (@CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg1 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) (fun (p1 : @SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) => @CompM.LRT_Fun unit (fun (p2 : unit) => @CompM.LRT_Fun unit (fun (p3 : unit) => @CompM.LRT_Fun unit (fun (p4 : unit) => @CompM.LRT_Ret (prod (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) (prod (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)) unit)))))))))) => f e0 (intToBv 64 0%Z) p0 tt tt tt)) tt). + +Definition contains0 : @CompM.lrtToType (@CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) (fun (perm0 : @SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) => @CompM.LRT_Ret (prod (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) (prod (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)) unit))))) := + SAWCoreScaffolding.fst contains0__tuple_fun. + +Definition zero_array__tuple_fun : @CompM.lrtTupleType (@CompM.LRT_Cons (@CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) (fun (perm0 : @SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) => @CompM.LRT_Ret (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)))))) (@CompM.LRT_Nil)) := + @CompM.multiFixM (@CompM.LRT_Cons (@CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) (fun (perm0 : @SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) => @CompM.LRT_Ret (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)))))) (@CompM.LRT_Nil)) (fun (zero_array : @CompM.lrtToType (@CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) (fun (perm0 : @SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) => @CompM.LRT_Ret (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))))))) => pair (fun (e0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (p0 : @SAWCorePrelude.BVVec 64 e0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) => @CompM.letRecM (@CompM.LRT_Cons (@CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg1 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) (fun (p1 : @SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) => @CompM.LRT_Fun unit (fun (p2 : unit) => @CompM.LRT_Fun unit (fun (p3 : unit) => @CompM.LRT_Fun unit (fun (p4 : unit) => @CompM.LRT_Ret (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)))))))))) (@CompM.LRT_Nil)) (@SAWCorePrelude.BVVec 64 e0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) (fun (f : @CompM.lrtToType (@CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg1 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) (fun (p1 : @SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) => @CompM.LRT_Fun unit (fun (p2 : unit) => @CompM.LRT_Fun unit (fun (p3 : unit) => @CompM.LRT_Fun unit (fun (p4 : unit) => @CompM.LRT_Ret (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))))))))))) => pair (fun (e1 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (e2 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (p1 : @SAWCorePrelude.BVVec 64 e1 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) (p2 : unit) (p3 : unit) (p4 : unit) => if @SAWCoreScaffolding.not (@SAWCorePrelude.bvEq 1 (if @SAWCoreVectorsAsCoqVectors.bvult 64 e2 e1 then intToBv 1 (-1)%Z else intToBv 1 0%Z) (intToBv 1 0%Z)) then if @SAWCoreScaffolding.and (@SAWCoreVectorsAsCoqVectors.bvsle 64 (intToBv 64 0xf000000000000000%Z) e2) (@SAWCoreVectorsAsCoqVectors.bvsle 64 e2 (intToBv 64 0xfffffffffffffff%Z)) then @SAWCorePrelude.maybe (@SAWCoreScaffolding.Eq (@SAWCoreScaffolding.Bool) (@SAWCoreVectorsAsCoqVectors.bvult 64 e2 e1) (@SAWCoreScaffolding.true)) (CompM (@SAWCorePrelude.BVVec 64 e1 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)))) (@errorM CompM _ (@SAWCorePrelude.BVVec 64 e1 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) "ghost_bv f e1 (@SAWCoreVectorsAsCoqVectors.bvAdd 64 e2 (intToBv 64 1%Z)) (@SAWCorePrelude.adjustBVVec 64 e1 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)) p1 (fun (fld0 : @sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)) => @existT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit) (intToBv 64 0%Z) tt) e2) tt tt tt) (@SAWCorePrelude.bvultWithProof 64 e2 e1) else @errorM CompM _ (@SAWCorePrelude.BVVec 64 e1 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) "Failed Assert at arrays.c:61:5"%string else @returnM CompM _ (@SAWCorePrelude.BVVec 64 e1 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) p1) tt) (fun (f : @CompM.lrtToType (@CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg1 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) (fun (p1 : @SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) => @CompM.LRT_Fun unit (fun (p2 : unit) => @CompM.LRT_Fun unit (fun (p3 : unit) => @CompM.LRT_Fun unit (fun (p4 : unit) => @CompM.LRT_Ret (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))))))))))) => f e0 (intToBv 64 0%Z) p0 tt tt tt)) tt). + +Definition zero_array : @CompM.lrtToType (@CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) (fun (perm0 : @SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) => @CompM.LRT_Ret (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)))))) := + SAWCoreScaffolding.fst zero_array__tuple_fun. + +Definition zero_array_from__tuple_fun : @CompM.lrtTupleType (@CompM.LRT_Cons (@CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg1 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) (fun (perm0 : @SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) => @CompM.LRT_Ret (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))))))) (@CompM.LRT_Nil)) := + @CompM.multiFixM (@CompM.LRT_Cons (@CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg1 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) (fun (perm0 : @SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) => @CompM.LRT_Ret (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))))))) (@CompM.LRT_Nil)) (fun (zero_array_from : @CompM.lrtToType (@CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg1 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) (fun (perm0 : @SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) => @CompM.LRT_Ret (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)))))))) => pair (fun (e0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (e1 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (p0 : @SAWCorePrelude.BVVec 64 e0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) => @CompM.letRecM (@CompM.LRT_Cons (@CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg1 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg2 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) (fun (p1 : @SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) => @CompM.LRT_Fun unit (fun (p2 : unit) => @CompM.LRT_Fun unit (fun (p3 : unit) => @CompM.LRT_Fun unit (fun (p4 : unit) => @CompM.LRT_Ret (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))))))))))) (@CompM.LRT_Nil)) (@SAWCorePrelude.BVVec 64 e0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) (fun (f : @CompM.lrtToType (@CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg1 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg2 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) (fun (p1 : @SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) => @CompM.LRT_Fun unit (fun (p2 : unit) => @CompM.LRT_Fun unit (fun (p3 : unit) => @CompM.LRT_Fun unit (fun (p4 : unit) => @CompM.LRT_Ret (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)))))))))))) => pair (fun (e2 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (e3 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (e4 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (p1 : @SAWCorePrelude.BVVec 64 e2 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) (p2 : unit) (p3 : unit) (p4 : unit) => if @SAWCoreScaffolding.not (@SAWCorePrelude.bvEq 1 (if @SAWCoreVectorsAsCoqVectors.bvult 64 e4 e2 then intToBv 1 (-1)%Z else intToBv 1 0%Z) (intToBv 1 0%Z)) then if @SAWCoreScaffolding.and (@SAWCoreVectorsAsCoqVectors.bvsle 64 (intToBv 64 0xf000000000000000%Z) e4) (@SAWCoreVectorsAsCoqVectors.bvsle 64 e4 (intToBv 64 0xfffffffffffffff%Z)) then @SAWCorePrelude.maybe (@SAWCoreScaffolding.Eq (@SAWCoreScaffolding.Bool) (@SAWCoreVectorsAsCoqVectors.bvult 64 e4 e2) (@SAWCoreScaffolding.true)) (CompM (@SAWCorePrelude.BVVec 64 e2 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)))) (@errorM CompM _ (@SAWCorePrelude.BVVec 64 e2 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) "ghost_bv f e2 e3 (@SAWCoreVectorsAsCoqVectors.bvAdd 64 e4 (intToBv 64 1%Z)) (@SAWCorePrelude.adjustBVVec 64 e2 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)) p1 (fun (fld0 : @sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)) => @existT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit) (intToBv 64 0%Z) tt) e4) tt tt tt) (@SAWCorePrelude.bvultWithProof 64 e4 e2) else @errorM CompM _ (@SAWCorePrelude.BVVec 64 e2 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) "Failed Assert at arrays.c:68:5"%string else @returnM CompM _ (@SAWCorePrelude.BVVec 64 e2 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) p1) tt) (fun (f : @CompM.lrtToType (@CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg1 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg2 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) (fun (p1 : @SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) => @CompM.LRT_Fun unit (fun (p2 : unit) => @CompM.LRT_Fun unit (fun (p3 : unit) => @CompM.LRT_Fun unit (fun (p4 : unit) => @CompM.LRT_Ret (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)))))))))))) => f e0 e1 e1 p0 tt tt tt)) tt). + +Definition zero_array_from : @CompM.lrtToType (@CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg1 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) (fun (perm0 : @SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) => @CompM.LRT_Ret (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))))))) := + SAWCoreScaffolding.fst zero_array_from__tuple_fun. + +Definition filter_and_sum_pos__tuple_fun : @CompM.lrtTupleType (@CompM.LRT_Cons (@CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) (fun (perm0 : @SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) => @CompM.LRT_Ret (prod (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) (prod (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)) unit))))) (@CompM.LRT_Nil)) := + @CompM.multiFixM (@CompM.LRT_Cons (@CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) (fun (perm0 : @SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) => @CompM.LRT_Ret (prod (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) (prod (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)) unit))))) (@CompM.LRT_Nil)) (fun (filter_and_sum_pos : @CompM.lrtToType (@CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) (fun (perm0 : @SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) => @CompM.LRT_Ret (prod (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) (prod (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)) unit)))))) => pair (fun (e0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (p0 : @SAWCorePrelude.BVVec 64 e0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) => @CompM.letRecM (@CompM.LRT_Cons (@CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg1 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg2 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) (fun (p1 : @SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) => @CompM.LRT_Fun unit (fun (p2 : unit) => @CompM.LRT_Fun unit (fun (p3 : unit) => @CompM.LRT_Fun unit (fun (p4 : unit) => @CompM.LRT_Fun unit (fun (p5 : unit) => @CompM.LRT_Ret (prod (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) (prod (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)) unit))))))))))) (@CompM.LRT_Cons (@CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg1 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg2 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) (fun (p1 : @SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) => @CompM.LRT_Fun unit (fun (p2 : unit) => @CompM.LRT_Fun unit (fun (p3 : unit) => @CompM.LRT_Fun unit (fun (p4 : unit) => @CompM.LRT_Fun unit (fun (p5 : unit) => @CompM.LRT_Fun unit (fun (p6 : unit) => @CompM.LRT_Fun unit (fun (p7 : unit) => @CompM.LRT_Fun unit (fun (p8 : unit) => @CompM.LRT_Ret (prod (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) (prod (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)) unit)))))))))))))) (@CompM.LRT_Nil))) (prod (@SAWCorePrelude.BVVec 64 e0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) (prod (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)) unit)) (fun (f : @CompM.lrtToType (@CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg1 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg2 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) (fun (p1 : @SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) => @CompM.LRT_Fun unit (fun (p2 : unit) => @CompM.LRT_Fun unit (fun (p3 : unit) => @CompM.LRT_Fun unit (fun (p4 : unit) => @CompM.LRT_Fun unit (fun (p5 : unit) => @CompM.LRT_Ret (prod (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) (prod (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)) unit)))))))))))) (f1 : @CompM.lrtToType (@CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg1 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg2 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) (fun (p1 : @SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) => @CompM.LRT_Fun unit (fun (p2 : unit) => @CompM.LRT_Fun unit (fun (p3 : unit) => @CompM.LRT_Fun unit (fun (p4 : unit) => @CompM.LRT_Fun unit (fun (p5 : unit) => @CompM.LRT_Fun unit (fun (p6 : unit) => @CompM.LRT_Fun unit (fun (p7 : unit) => @CompM.LRT_Fun unit (fun (p8 : unit) => @CompM.LRT_Ret (prod (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) (prod (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)) unit))))))))))))))) => pair (fun (e1 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (e2 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (e3 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (p1 : @SAWCorePrelude.BVVec 64 e1 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) (p2 : unit) (p3 : unit) (p4 : unit) (p5 : unit) => if @SAWCoreScaffolding.not (@SAWCorePrelude.bvEq 1 (if @SAWCoreVectorsAsCoqVectors.bvult 64 e3 e1 then intToBv 1 (-1)%Z else intToBv 1 0%Z) (intToBv 1 0%Z)) then if @SAWCoreScaffolding.and (@SAWCoreVectorsAsCoqVectors.bvsle 64 (intToBv 64 0xf000000000000000%Z) e3) (@SAWCoreVectorsAsCoqVectors.bvsle 64 e3 (intToBv 64 0xfffffffffffffff%Z)) then @SAWCorePrelude.maybe (@SAWCoreScaffolding.Eq (@SAWCoreScaffolding.Bool) (@SAWCoreVectorsAsCoqVectors.bvult 64 e3 e1) (@SAWCoreScaffolding.true)) (CompM (prod (@SAWCorePrelude.BVVec 64 e1 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) (prod (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)) unit))) (@errorM CompM _ (prod (@SAWCorePrelude.BVVec 64 e1 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) (prod (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)) unit)) "ghost_bv1 if @SAWCoreScaffolding.not (@SAWCorePrelude.bvEq 1 (if @SAWCoreVectorsAsCoqVectors.bvslt 64 (@projT1 (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_elimEx0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit) (@SAWCorePrelude.atBVVec 64 e1 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)) p1 e3 ult_pf0)) (intToBv 64 0%Z) then intToBv 1 (-1)%Z else intToBv 1 0%Z) (intToBv 1 0%Z)) then if @SAWCoreScaffolding.and (@SAWCoreVectorsAsCoqVectors.bvsle 64 (intToBv 64 0xf000000000000000%Z) e3) (@SAWCoreVectorsAsCoqVectors.bvsle 64 e3 (intToBv 64 0xfffffffffffffff%Z)) then f1 e1 e2 e3 (@SAWCorePrelude.adjustBVVec 64 e1 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)) p1 (fun (fld0 : @sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)) => @existT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit) (intToBv 64 0%Z) tt) e3) tt tt tt tt tt tt tt else @errorM CompM _ (prod (@SAWCorePrelude.BVVec 64 e1 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) (prod (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)) unit)) "Failed Assert at arrays.c:78:7"%string else f1 e1 e2 e3 (@SAWCorePrelude.adjustBVVec 64 e1 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)) p1 (fun (fld0 : @sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)) => @existT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit) (@projT1 (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_elimEx0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit) (@SAWCorePrelude.atBVVec 64 e1 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)) p1 e3 ult_pf0)) tt) e3) tt tt tt tt tt tt tt) (@SAWCorePrelude.bvultWithProof 64 e3 e1) else @errorM CompM _ (prod (@SAWCorePrelude.BVVec 64 e1 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) (prod (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)) unit)) "Failed Assert at arrays.c:77:9"%string else @returnM CompM _ (prod (@SAWCorePrelude.BVVec 64 e1 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) (prod (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)) unit)) (pair p1 (pair (@existT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit) e2 tt) tt))) (pair (fun (e1 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (e2 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (e3 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (p1 : @SAWCorePrelude.BVVec 64 e1 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) (p2 : unit) (p3 : unit) (p4 : unit) (p5 : unit) (p6 : unit) (p7 : unit) (p8 : unit) => if @SAWCoreScaffolding.and (@SAWCoreVectorsAsCoqVectors.bvsle 64 (intToBv 64 0xf000000000000000%Z) e3) (@SAWCoreVectorsAsCoqVectors.bvsle 64 e3 (intToBv 64 0xfffffffffffffff%Z)) then @SAWCorePrelude.maybe (@SAWCoreScaffolding.Eq (@SAWCoreScaffolding.Bool) (@SAWCoreVectorsAsCoqVectors.bvult 64 e3 e1) (@SAWCoreScaffolding.true)) (CompM (prod (@SAWCorePrelude.BVVec 64 e1 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) (prod (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)) unit))) (@errorM CompM _ (prod (@SAWCorePrelude.BVVec 64 e1 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) (prod (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)) unit)) "ghost_bv1 f e1 (@SAWCoreVectorsAsCoqVectors.bvAdd 64 e2 (@projT1 (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_elimEx0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit) (@existT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit) (@projT1 (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_elimEx0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit) (@SAWCorePrelude.atBVVec 64 e1 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)) p1 e3 ult_pf0)) tt))) (@SAWCoreVectorsAsCoqVectors.bvAdd 64 e3 (intToBv 64 1%Z)) (@SAWCorePrelude.adjustBVVec 64 e1 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)) p1 (fun (fld0 : @sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)) => @existT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit) (@projT1 (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_elimEx0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit) (@existT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit) (@projT1 (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_elimEx0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit) (@SAWCorePrelude.atBVVec 64 e1 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)) p1 e3 ult_pf0)) tt)) tt) e3) tt p5 tt tt) (@SAWCorePrelude.bvultWithProof 64 e3 e1) else @errorM CompM _ (prod (@SAWCorePrelude.BVVec 64 e1 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) (prod (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)) unit)) "Failed Assert at arrays.c:80:12"%string) tt)) (fun (f : @CompM.lrtToType (@CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg1 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg2 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) (fun (p1 : @SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) => @CompM.LRT_Fun unit (fun (p2 : unit) => @CompM.LRT_Fun unit (fun (p3 : unit) => @CompM.LRT_Fun unit (fun (p4 : unit) => @CompM.LRT_Fun unit (fun (p5 : unit) => @CompM.LRT_Ret (prod (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) (prod (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)) unit)))))))))))) (f1 : @CompM.lrtToType (@CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg1 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg2 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) (fun (p1 : @SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) => @CompM.LRT_Fun unit (fun (p2 : unit) => @CompM.LRT_Fun unit (fun (p3 : unit) => @CompM.LRT_Fun unit (fun (p4 : unit) => @CompM.LRT_Fun unit (fun (p5 : unit) => @CompM.LRT_Fun unit (fun (p6 : unit) => @CompM.LRT_Fun unit (fun (p7 : unit) => @CompM.LRT_Fun unit (fun (p8 : unit) => @CompM.LRT_Ret (prod (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) (prod (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)) unit))))))))))))))) => f e0 (intToBv 64 0%Z) (intToBv 64 0%Z) p0 tt tt tt tt)) tt). + +Definition filter_and_sum_pos : @CompM.lrtToType (@CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) (fun (perm0 : @SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) => @CompM.LRT_Ret (prod (@SAWCorePrelude.BVVec 64 arg0 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) (prod (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)) unit))))) := + SAWCoreScaffolding.fst filter_and_sum_pos__tuple_fun. + +Definition sum_2d__tuple_fun : @CompM.lrtTupleType (@CompM.LRT_Cons (@CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg1 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCorePrelude.BVVec 64 arg0 (@SAWCorePrelude.BVVec 64 arg1 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)))) (fun (perm0 : @SAWCorePrelude.BVVec 64 arg0 (@SAWCorePrelude.BVVec 64 arg1 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)))) => @CompM.LRT_Ret (prod (@SAWCorePrelude.BVVec 64 arg0 (@SAWCorePrelude.BVVec 64 arg1 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)))) (prod (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)) unit)))))) (@CompM.LRT_Nil)) := + @CompM.multiFixM (@CompM.LRT_Cons (@CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg1 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCorePrelude.BVVec 64 arg0 (@SAWCorePrelude.BVVec 64 arg1 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)))) (fun (perm0 : @SAWCorePrelude.BVVec 64 arg0 (@SAWCorePrelude.BVVec 64 arg1 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)))) => @CompM.LRT_Ret (prod (@SAWCorePrelude.BVVec 64 arg0 (@SAWCorePrelude.BVVec 64 arg1 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)))) (prod (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)) unit)))))) (@CompM.LRT_Nil)) (fun (sum_2d : @CompM.lrtToType (@CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg1 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCorePrelude.BVVec 64 arg0 (@SAWCorePrelude.BVVec 64 arg1 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)))) (fun (perm0 : @SAWCorePrelude.BVVec 64 arg0 (@SAWCorePrelude.BVVec 64 arg1 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)))) => @CompM.LRT_Ret (prod (@SAWCorePrelude.BVVec 64 arg0 (@SAWCorePrelude.BVVec 64 arg1 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)))) (prod (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)) unit))))))) => pair (fun (e0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (e1 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (p0 : @SAWCorePrelude.BVVec 64 e0 (@SAWCorePrelude.BVVec 64 e1 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)))) => @CompM.letRecM (@CompM.LRT_Cons (@CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg1 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg2 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg3 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCorePrelude.BVVec 64 arg0 (@SAWCorePrelude.BVVec 64 arg1 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)))) (fun (p1 : @SAWCorePrelude.BVVec 64 arg0 (@SAWCorePrelude.BVVec 64 arg1 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)))) => @CompM.LRT_Fun unit (fun (p2 : unit) => @CompM.LRT_Fun unit (fun (p3 : unit) => @CompM.LRT_Fun unit (fun (p4 : unit) => @CompM.LRT_Fun unit (fun (p5 : unit) => @CompM.LRT_Fun unit (fun (p6 : unit) => @CompM.LRT_Fun unit (fun (p7 : unit) => @CompM.LRT_Ret (prod (@SAWCorePrelude.BVVec 64 arg0 (@SAWCorePrelude.BVVec 64 arg1 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)))) (prod (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)) unit)))))))))))))) (@CompM.LRT_Cons (@CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg1 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg2 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg3 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg4 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg5 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg6 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg7 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg8 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg9 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg10 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCorePrelude.BVVec 64 arg0 (@SAWCorePrelude.BVVec 64 arg1 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)))) (fun (p1 : @SAWCorePrelude.BVVec 64 arg0 (@SAWCorePrelude.BVVec 64 arg1 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)))) => @CompM.LRT_Fun unit (fun (p2 : unit) => @CompM.LRT_Fun unit (fun (p3 : unit) => @CompM.LRT_Fun unit (fun (p4 : unit) => @CompM.LRT_Fun unit (fun (p5 : unit) => @CompM.LRT_Fun unit (fun (p6 : unit) => @CompM.LRT_Fun unit (fun (p7 : unit) => @CompM.LRT_Fun (@SAWCorePrelude.BVVec 64 arg1 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) (fun (p8 : @SAWCorePrelude.BVVec 64 arg1 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) => @CompM.LRT_Fun (@SAWCorePrelude.BVVec 64 arg1 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) (fun (p9 : @SAWCorePrelude.BVVec 64 arg1 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) => @CompM.LRT_Fun (@SAWCorePrelude.BVVec 64 arg1 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) (fun (p10 : @SAWCorePrelude.BVVec 64 arg1 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) => @CompM.LRT_Fun (@SAWCorePrelude.BVVec 64 arg1 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) (fun (p11 : @SAWCorePrelude.BVVec 64 arg1 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) => @CompM.LRT_Ret (prod (@SAWCorePrelude.BVVec 64 arg0 (@SAWCorePrelude.BVVec 64 arg1 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)))) (prod (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)) unit))))))))))))))))))))))))) (@CompM.LRT_Nil))) (prod (@SAWCorePrelude.BVVec 64 e0 (@SAWCorePrelude.BVVec 64 e1 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)))) (prod (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)) unit)) (fun (f : @CompM.lrtToType (@CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg1 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg2 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg3 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCorePrelude.BVVec 64 arg0 (@SAWCorePrelude.BVVec 64 arg1 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)))) (fun (p1 : @SAWCorePrelude.BVVec 64 arg0 (@SAWCorePrelude.BVVec 64 arg1 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)))) => @CompM.LRT_Fun unit (fun (p2 : unit) => @CompM.LRT_Fun unit (fun (p3 : unit) => @CompM.LRT_Fun unit (fun (p4 : unit) => @CompM.LRT_Fun unit (fun (p5 : unit) => @CompM.LRT_Fun unit (fun (p6 : unit) => @CompM.LRT_Fun unit (fun (p7 : unit) => @CompM.LRT_Ret (prod (@SAWCorePrelude.BVVec 64 arg0 (@SAWCorePrelude.BVVec 64 arg1 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)))) (prod (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)) unit))))))))))))))) (f1 : @CompM.lrtToType (@CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg1 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg2 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg3 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg4 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg5 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg6 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg7 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg8 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg9 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg10 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCorePrelude.BVVec 64 arg0 (@SAWCorePrelude.BVVec 64 arg1 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)))) (fun (p1 : @SAWCorePrelude.BVVec 64 arg0 (@SAWCorePrelude.BVVec 64 arg1 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)))) => @CompM.LRT_Fun unit (fun (p2 : unit) => @CompM.LRT_Fun unit (fun (p3 : unit) => @CompM.LRT_Fun unit (fun (p4 : unit) => @CompM.LRT_Fun unit (fun (p5 : unit) => @CompM.LRT_Fun unit (fun (p6 : unit) => @CompM.LRT_Fun unit (fun (p7 : unit) => @CompM.LRT_Fun (@SAWCorePrelude.BVVec 64 arg1 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) (fun (p8 : @SAWCorePrelude.BVVec 64 arg1 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) => @CompM.LRT_Fun (@SAWCorePrelude.BVVec 64 arg1 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) (fun (p9 : @SAWCorePrelude.BVVec 64 arg1 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) => @CompM.LRT_Fun (@SAWCorePrelude.BVVec 64 arg1 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) (fun (p10 : @SAWCorePrelude.BVVec 64 arg1 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) => @CompM.LRT_Fun (@SAWCorePrelude.BVVec 64 arg1 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) (fun (p11 : @SAWCorePrelude.BVVec 64 arg1 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) => @CompM.LRT_Ret (prod (@SAWCorePrelude.BVVec 64 arg0 (@SAWCorePrelude.BVVec 64 arg1 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)))) (prod (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)) unit)))))))))))))))))))))))))) => pair (fun (e2 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (e3 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (e4 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (e5 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (p1 : @SAWCorePrelude.BVVec 64 e2 (@SAWCorePrelude.BVVec 64 e3 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)))) (p2 : unit) (p3 : unit) (p4 : unit) (p5 : unit) (p6 : unit) (p7 : unit) => if @SAWCoreScaffolding.not (@SAWCorePrelude.bvEq 1 (if @SAWCoreVectorsAsCoqVectors.bvult 64 e5 e2 then intToBv 1 (-1)%Z else intToBv 1 0%Z) (intToBv 1 0%Z)) then @errorM CompM _ (prod (@SAWCorePrelude.BVVec 64 e2 (@SAWCorePrelude.BVVec 64 e3 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)))) (prod (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)) unit)) " + Could not prove + (z13, z12, z11, z10, z9, z8, z7, z6, z5, z4, z3, z2, z1, z). + top_bv:true, top_bv1:true, + top_ptr:array(0, + array(0, + exists z14. eq(LLVMword z14)], + [])], []), + top_ptr1:eq(LLVMword top_bv), top_ptr2:eq(LLVMword top_bv1), + local_ptr:memblock(W, 0, 8, fieldsh(eq(top_ptr))), + local_ptr1:memblock(W, 0, 8, fieldsh(eq(LLVMword top_bv))), + local_ptr2:memblock(W, 0, 8, fieldsh(eq(LLVMword top_bv1))), + local_ptr3:memblock(W, 0, 8, fieldsh(eq(LLVMword z11))), + local_ptr4:memblock(W, 0, 8, fieldsh(eq(LLVMword z7))), + local_ptr5:memblock(W, 0, 8, fieldsh(eq(LLVMword z))), + z13:llvmframe [local_ptr5:8, local_ptr4:8, local_ptr3:8, + local_ptr2:8, local_ptr1:8, local_ptr:8], + z12:array(0, + exists z14. eq(LLVMword z14)], [(0).0]) + *ptr((W,0) |-> eq(LLVMword z11)), z11:true, z10:true, + z9:array(0, + exists z14. eq(LLVMword z14)], [(z10).0]) + *ptr((W,8*z10+0) |-> eq(LLVMword z8)), z8:true, z7:true, + z6:true, z5:array(0, + exists z14. eq(LLVMword z14)], + [(z6).0]) + *ptr((W,8*z6+0) |-> eq(LLVMword z4)), z4:true, z3:true, + z2:array(0, + exists z14. eq(LLVMword z14)], [(z3).0]) + *ptr((W,8*z3+0) |-> eq(LLVMword z1)), z1:true, z:true + + Could not determine enough variables to prove permissions: (z13, + z12, z11, z10, z9, + z8, z7, z6, z5, z4, + z3, z2, z1, z). + z12:array(0, + exists z14. eq(LLVMword z14)], [(0).0]) + *ptr((W,0) |-> eq(LLVMword z11)), z10:true, + z9:array(0, + exists z14. eq(LLVMword z14)], [(z10).0]) + *ptr((W,8*z10+0) |-> eq(LLVMword z8)), z8:true, z6:true, + z5:array(0, + exists z14. eq(LLVMword z14)], [(z6).0]) + *ptr((W,8*z6+0) |-> eq(LLVMword z4)), z4:true, z3:true, + z2:array(0, + exists z14. eq(LLVMword z14)], [(z3).0]) + *ptr((W,8*z3+0) |-> eq(LLVMword z1)), z1:true"%string else @returnM CompM _ (prod (@SAWCorePrelude.BVVec 64 e2 (@SAWCorePrelude.BVVec 64 e3 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)))) (prod (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)) unit)) (pair p1 (pair (@existT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit) e4 tt) tt))) (pair (fun (e2 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (e3 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (e4 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (e5 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (e6 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (e7 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (e8 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (e9 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (e10 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (e11 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (e12 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (p1 : @SAWCorePrelude.BVVec 64 e2 (@SAWCorePrelude.BVVec 64 e3 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)))) (p2 : unit) (p3 : unit) (p4 : unit) (p5 : unit) (p6 : unit) (p7 : unit) (p8 : @SAWCorePrelude.BVVec 64 e3 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) (p9 : @SAWCorePrelude.BVVec 64 e3 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) (p10 : @SAWCorePrelude.BVVec 64 e3 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) (p11 : @SAWCorePrelude.BVVec 64 e3 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) => if @SAWCoreScaffolding.not (@SAWCorePrelude.bvEq 1 (if @SAWCoreVectorsAsCoqVectors.bvult 64 e12 e3 then intToBv 1 (-1)%Z else intToBv 1 0%Z) (intToBv 1 0%Z)) then if @SAWCoreScaffolding.and (@SAWCoreVectorsAsCoqVectors.bvsle 64 (intToBv 64 0xf000000000000000%Z) e7) (@SAWCoreVectorsAsCoqVectors.bvsle 64 e7 (intToBv 64 0xfffffffffffffff%Z)) then @SAWCorePrelude.maybe (@SAWCoreScaffolding.Eq (@SAWCoreScaffolding.Bool) (@SAWCoreVectorsAsCoqVectors.bvult 64 e7 e2) (@SAWCoreScaffolding.true)) (CompM (prod (@SAWCorePrelude.BVVec 64 e2 (@SAWCorePrelude.BVVec 64 e3 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)))) (prod (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)) unit))) (@errorM CompM _ (prod (@SAWCorePrelude.BVVec 64 e2 (@SAWCorePrelude.BVVec 64 e3 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)))) (prod (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)) unit)) "ghost_bv1 if @SAWCoreScaffolding.and (@SAWCoreVectorsAsCoqVectors.bvsle 64 (intToBv 64 0xf000000000000000%Z) e12) (@SAWCoreVectorsAsCoqVectors.bvsle 64 e12 (intToBv 64 0xfffffffffffffff%Z)) then @SAWCorePrelude.maybe (@SAWCoreScaffolding.Eq (@SAWCoreScaffolding.Bool) (@SAWCoreVectorsAsCoqVectors.bvult 64 e12 e3) (@SAWCoreScaffolding.true)) (CompM (prod (@SAWCorePrelude.BVVec 64 e2 (@SAWCorePrelude.BVVec 64 e3 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)))) (prod (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)) unit))) (@errorM CompM _ (prod (@SAWCorePrelude.BVVec 64 e2 (@SAWCorePrelude.BVVec 64 e3 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)))) (prod (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)) unit)) "ghost_bv2 @errorM CompM _ (prod (@SAWCorePrelude.BVVec 64 e2 (@SAWCorePrelude.BVVec 64 e3 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)))) (prod (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)) unit)) " + Could not prove + (z13, z12, z11, z10, z9, z8, z7, z6, z5, z4, z3, z2, z1, z). + top_bv:true, top_bv1:true, + top_ptr:array(0, + array(0, + exists z14. eq(LLVMword z14)], + [])], []), + top_ptr1:eq(LLVMword top_bv), top_ptr2:eq(LLVMword top_bv1), + local_ptr:memblock(W, 0, 8, fieldsh(eq(top_ptr))), + local_ptr1:memblock(W, 0, 8, fieldsh(eq(LLVMword top_bv))), + local_ptr2:memblock(W, 0, 8, fieldsh(eq(LLVMword top_bv1))), + local_ptr3:memblock(W, 0, 8, fieldsh(eq(LLVMword z11))), + local_ptr4:memblock(W, 0, 8, fieldsh(eq(LLVMword z7))), + local_ptr5:memblock(W, 0, 8, fieldsh(eq(LLVMword z))), + z13:llvmframe [local_ptr5:8, local_ptr4:8, local_ptr3:8, + local_ptr2:8, local_ptr1:8, local_ptr:8], + z12:array(0, + exists z14. eq(LLVMword z14)], [(0).0]) + *ptr((W,0) |-> eq(LLVMword z11)), z11:true, z10:true, + z9:array(0, + exists z14. eq(LLVMword z14)], [(z10).0]) + *ptr((W,8*z10+0) |-> eq(LLVMword z8)), z8:true, z7:true, + z6:true, z5:array(0, + exists z14. eq(LLVMword z14)], + [(z6).0]) + *ptr((W,8*z6+0) |-> eq(LLVMword z4)), z4:true, z3:true, + z2:array(0, + exists z14. eq(LLVMword z14)], [(z3).0]) + *ptr((W,8*z3+0) |-> eq(LLVMword z1)), z1:true, z:true + + Could not determine enough variables to prove permissions: (z13, + z12, z11, z10, z9, + z8, z7, z6, z5, z4, + z3, z2, z1, z). + z12:array(0, + exists z14. eq(LLVMword z14)], [(0).0]) + *ptr((W,0) |-> eq(LLVMword z11)), z10:true, + z9:array(0, + exists z14. eq(LLVMword z14)], [(z10).0]) + *ptr((W,8*z10+0) |-> eq(LLVMword z8)), z8:true, z6:true, + z5:array(0, + exists z14. eq(LLVMword z14)], [(z6).0]) + *ptr((W,8*z6+0) |-> eq(LLVMword z4)), z4:true, z3:true, + z2:array(0, + exists z14. eq(LLVMword z14)], [(z3).0]) + *ptr((W,8*z3+0) |-> eq(LLVMword z1)), z1:true"%string) (@SAWCorePrelude.bvultWithProof 64 e12 e3) else @errorM CompM _ (prod (@SAWCorePrelude.BVVec 64 e2 (@SAWCorePrelude.BVVec 64 e3 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)))) (prod (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)) unit)) "Failed Assert at arrays.c:89:14"%string) (@SAWCorePrelude.bvultWithProof 64 e7 e2) else @errorM CompM _ (prod (@SAWCorePrelude.BVVec 64 e2 (@SAWCorePrelude.BVVec 64 e3 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)))) (prod (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)) unit)) "Failed Assert at arrays.c:89:14"%string else f e2 e3 e4 (@SAWCoreVectorsAsCoqVectors.bvAdd 64 e7 (intToBv 64 1%Z)) p1 p2 p3 tt tt tt tt) tt)) (fun (f : @CompM.lrtToType (@CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg1 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg2 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg3 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCorePrelude.BVVec 64 arg0 (@SAWCorePrelude.BVVec 64 arg1 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)))) (fun (p1 : @SAWCorePrelude.BVVec 64 arg0 (@SAWCorePrelude.BVVec 64 arg1 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)))) => @CompM.LRT_Fun unit (fun (p2 : unit) => @CompM.LRT_Fun unit (fun (p3 : unit) => @CompM.LRT_Fun unit (fun (p4 : unit) => @CompM.LRT_Fun unit (fun (p5 : unit) => @CompM.LRT_Fun unit (fun (p6 : unit) => @CompM.LRT_Fun unit (fun (p7 : unit) => @CompM.LRT_Ret (prod (@SAWCorePrelude.BVVec 64 arg0 (@SAWCorePrelude.BVVec 64 arg1 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)))) (prod (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)) unit))))))))))))))) (f1 : @CompM.lrtToType (@CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg1 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg2 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg3 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg4 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg5 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg6 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg7 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg8 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg9 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg10 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCorePrelude.BVVec 64 arg0 (@SAWCorePrelude.BVVec 64 arg1 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)))) (fun (p1 : @SAWCorePrelude.BVVec 64 arg0 (@SAWCorePrelude.BVVec 64 arg1 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)))) => @CompM.LRT_Fun unit (fun (p2 : unit) => @CompM.LRT_Fun unit (fun (p3 : unit) => @CompM.LRT_Fun unit (fun (p4 : unit) => @CompM.LRT_Fun unit (fun (p5 : unit) => @CompM.LRT_Fun unit (fun (p6 : unit) => @CompM.LRT_Fun unit (fun (p7 : unit) => @CompM.LRT_Fun (@SAWCorePrelude.BVVec 64 arg1 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) (fun (p8 : @SAWCorePrelude.BVVec 64 arg1 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) => @CompM.LRT_Fun (@SAWCorePrelude.BVVec 64 arg1 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) (fun (p9 : @SAWCorePrelude.BVVec 64 arg1 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) => @CompM.LRT_Fun (@SAWCorePrelude.BVVec 64 arg1 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) (fun (p10 : @SAWCorePrelude.BVVec 64 arg1 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) => @CompM.LRT_Fun (@SAWCorePrelude.BVVec 64 arg1 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) (fun (p11 : @SAWCorePrelude.BVVec 64 arg1 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit))) => @CompM.LRT_Ret (prod (@SAWCorePrelude.BVVec 64 arg0 (@SAWCorePrelude.BVVec 64 arg1 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)))) (prod (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)) unit)))))))))))))))))))))))))) => f e0 e1 (intToBv 64 0%Z) (intToBv 64 0%Z) p0 tt tt tt tt tt tt)) tt). + +Definition sum_2d : @CompM.lrtToType (@CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (arg1 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => @CompM.LRT_Fun (@SAWCorePrelude.BVVec 64 arg0 (@SAWCorePrelude.BVVec 64 arg1 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)))) (fun (perm0 : @SAWCorePrelude.BVVec 64 arg0 (@SAWCorePrelude.BVVec 64 arg1 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)))) => @CompM.LRT_Ret (prod (@SAWCorePrelude.BVVec 64 arg0 (@SAWCorePrelude.BVVec 64 arg1 (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)))) (prod (@sigT (@SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) (fun (x_ex0 : @SAWCoreVectorsAsCoqVectors.Vec 64 (@SAWCoreScaffolding.Bool)) => unit)) unit)))))) := + SAWCoreScaffolding.fst sum_2d__tuple_fun. End arrays.