diff --git a/src/SAWScript/Builtins.hs b/src/SAWScript/Builtins.hs index 0b37971544..d74047335d 100644 --- a/src/SAWScript/Builtins.hs +++ b/src/SAWScript/Builtins.hs @@ -924,13 +924,13 @@ provePrim script t = do _ -> return () return res -provePrintPrim :: +proveHelper :: ProofScript () -> TypedTerm -> + (Term -> TopLevel Prop) -> TopLevel Theorem -provePrintPrim script t = do - sc <- getSharedContext - prop <- io $ predicateToProp sc Universal (ttTerm t) +proveHelper script t f = do + prop <- f $ ttTerm t let goal = ProofGoal 0 "prove" "prove" prop opts <- rwPPOpts <$> getTopLevelRW res <- SV.runProofScript script goal Nothing "prove_print_prim" @@ -944,6 +944,22 @@ provePrintPrim script t = do InvalidProof _stats _cex pst -> failProof pst UnfinishedProof pst -> failProof pst +provePrintPrim :: + ProofScript () -> + TypedTerm -> + TopLevel Theorem +provePrintPrim script t = do + sc <- getSharedContext + proveHelper script t $ io . predicateToProp sc Universal + +provePropPrim :: + ProofScript () -> + TypedTerm -> + TopLevel Theorem +provePropPrim script t = do + sc <- getSharedContext + proveHelper script t $ io . termToProp sc + satPrim :: ProofScript () -> TypedTerm -> diff --git a/src/SAWScript/Interpreter.hs b/src/SAWScript/Interpreter.hs index 93dc3e3118..9835aca5aa 100644 --- a/src/SAWScript/Interpreter.hs +++ b/src/SAWScript/Interpreter.hs @@ -1313,6 +1313,15 @@ primitives = Map.fromList , "if unsuccessful." ] + , prim "prove_extcore" "ProofScript () -> Term -> TopLevel Theorem" + (pureVal provePropPrim) + Current + [ "Use the given proof script to attempt to prove that a term representing" + , "a proposition is valid. For example, this is useful for proving a goal" + , "obtained with 'offline_extcore'. Returns a Theorem if successful, and" + , "aborts if unsuccessful." + ] + , prim "sat" "ProofScript () -> Term -> TopLevel SatResult" (pureVal satPrim) Current