Skip to content

Commit 3d62f32

Browse files
author
Eddy Westbrook
authored
Merge branch 'master' into mr-solver/reorg
2 parents bf442c7 + d31f778 commit 3d62f32

File tree

4 files changed

+142
-38
lines changed

4 files changed

+142
-38
lines changed

‎.github/workflows/ci.yml

+34
Original file line numberDiff line numberDiff line change
@@ -197,6 +197,40 @@ jobs:
197197
name: "saw-${{ runner.os }}-${{ matrix.ghc }}"
198198
path: "dist/bin/saw"
199199

200+
mr-solver-tests:
201+
needs: [build]
202+
strategy:
203+
fail-fast: false
204+
matrix:
205+
os: [ubuntu-latest, macos-10.15]
206+
runs-on: ${{ matrix.os }}
207+
steps:
208+
- uses: actions/checkout@v2
209+
with:
210+
submodules: true
211+
212+
- shell: bash
213+
run: .github/ci.sh install_system_deps
214+
env:
215+
BUILD_TARGET_OS: ${{ matrix.os }}
216+
217+
- uses: actions/download-artifact@v2
218+
with:
219+
name: "${{ runner.os }}-bins"
220+
path: dist/bin
221+
222+
- name: Update PATH to include SAW
223+
shell: bash
224+
run: |
225+
chmod +x dist/bin/*
226+
echo $GITHUB_WORKSPACE/dist/bin >> $GITHUB_PATH
227+
228+
- working-directory: examples/mr_solver
229+
shell: bash
230+
run: |
231+
saw monadify.saw
232+
saw mr_solver_unit_tests.saw
233+
200234
heapster-tests:
201235
needs: [build]
202236
strategy:

‎examples/mr_solver/monadify.saw

+93-30
Original file line numberDiff line numberDiff line change
@@ -2,50 +2,113 @@
22
enable_experimental;
33
import "SpecPrims.cry" as SpecPrims;
44
import "monadify.cry";
5+
load_sawcore_from_file "../../cryptol-saw-core/saw/CryptolM.sawcore";
56
set_monadification "SpecPrims::exists" "Prelude.existsM";
67
set_monadification "SpecPrims::forall" "Prelude.forallM";
78

9+
let run_test name cry_term mon_term_expected =
10+
do { print (str_concat "Test: " name);
11+
print "Original term:";
12+
print_term cry_term;
13+
mon_term <- monadify_term cry_term;
14+
print "Monadified term:";
15+
print_term mon_term;
16+
success <- is_convertible mon_term mon_term_expected;
17+
if success then print "Success - monadified term matched expected\n" else
18+
do { print "Test failed - did not match expected monadified term:";
19+
print_term mon_term_expected;
20+
exit 1; }; };
21+
822
my_abs <- unfold_term ["my_abs"] {{ my_abs }};
9-
print "[my_abs] original term:";
10-
print_term my_abs;
11-
my_absM <- monadify_term my_abs;
12-
print "[my_abs] monadified term:";
13-
print_term my_absM;
23+
my_abs_M <- parse_core_mod "CryptolM" "\
24+
\ \\(x : (mseq (TCNum 64) Bool)) -> \
25+
\ bindM (isFinite (TCNum 64)) (mseq (TCNum 64) Bool) (assertFiniteM (TCNum 64)) \
26+
\ (\\(x' : (isFinite (TCNum 64))) -> \
27+
\ bindM (isFinite (TCNum 64)) (mseq (TCNum 64) Bool) (assertFiniteM (TCNum 64)) \
28+
\ (\\(x'' : (isFinite (TCNum 64))) -> \
29+
\ ite (CompM (mseq (TCNum 64) Bool)) \
30+
\ (ecLt (mseq (TCNum 64) Bool) (PCmpMSeqBool (TCNum 64) x') x \
31+
\ (ecNumber (TCNum 0) (mseq (TCNum 64) Bool) (PLiteralSeqBoolM (TCNum 64) x''))) \
32+
\ (bindM (isFinite (TCNum 64)) (mseq (TCNum 64) Bool) (assertFiniteM (TCNum 64)) \
33+
\ (\\(x''' : (isFinite (TCNum 64))) -> \
34+
\ returnM (mseq (TCNum 64) Bool) (ecNeg (mseq (TCNum 64) Bool) (PRingMSeqBool (TCNum 64) x''') x))) \
35+
\ (returnM (mseq (TCNum 64) Bool) x)))";
36+
run_test "my_abs" my_abs my_abs_M;
1437

15-
/*
1638
err_if_lt0 <- unfold_term ["err_if_lt0"] {{ err_if_lt0 }};
17-
print "[err_if_lt0] original term:";
18-
err_if_lt0M <- monadify_term err_if_lt0;
19-
print "[err_if_lt0] monadified term:";
20-
print_term err_if_lt0M;
21-
*/
39+
err_if_lt0_M <- parse_core_mod "CryptolM" "\
40+
\ \\(x : (mseq (TCNum 64) Bool)) -> \
41+
\ bindM (isFinite (TCNum 64)) (mseq (TCNum 64) Bool) (assertFiniteM (TCNum 64)) \
42+
\ (\\(x' : (isFinite (TCNum 64))) -> \
43+
\ bindM (isFinite (TCNum 64)) (mseq (TCNum 64) Bool) (assertFiniteM (TCNum 64)) \
44+
\ (\\(x'' : (isFinite (TCNum 64))) -> \
45+
\ ite (CompM (mseq (TCNum 64) Bool)) \
46+
\ (ecLt (mseq (TCNum 64) Bool) (PCmpMSeqBool (TCNum 64) x') x \
47+
\ (ecNumber (TCNum 0) (mseq (TCNum 64) Bool) (PLiteralSeqBoolM (TCNum 64) x''))) \
48+
\ (bindM (isFinite (TCNum 8)) (mseq (TCNum 64) Bool) (assertFiniteM (TCNum 8)) \
49+
\ (\\(x''' : (isFinite (TCNum 8))) -> \
50+
\ ecErrorM (mseq (TCNum 64) Bool) (TCNum 5) \
51+
\ (seqToMseq (TCNum 5) (mseq (TCNum 8) Bool) \
52+
\ [ ecNumber (TCNum 120) (mseq (TCNum 8) Bool) (PLiteralSeqBoolM (TCNum 8) x''') \
53+
\ , (ecNumber (TCNum 32) (mseq (TCNum 8) Bool) (PLiteralSeqBoolM (TCNum 8) x''')) \
54+
\ , ecNumber (TCNum 60) (mseq (TCNum 8) Bool) (PLiteralSeqBoolM (TCNum 8) x''') \
55+
\ , (ecNumber (TCNum 32) (mseq (TCNum 8) Bool) (PLiteralSeqBoolM (TCNum 8) x''')) \
56+
\ , ecNumber (TCNum 48) (mseq (TCNum 8) Bool) (PLiteralSeqBoolM (TCNum 8) x''') ]))) \
57+
\ (returnM (mseq (TCNum 64) Bool) x)))";
58+
run_test "err_if_lt0" err_if_lt0 err_if_lt0_M;
2259

2360
/*
2461
sha1 <- {{ sha1 }};
25-
print "[SHA1] original term:";
62+
print "Test: sha1";
63+
print "Original term:";
2664
print_term sha1;
27-
mtrm <- monadify_term sha1;
28-
print "[SHA1] monadified term:";
29-
print_term mtrm;
65+
sha1M <- monadify_term sha1;
66+
print "Monadified term:";
67+
print_term sha1M;
3068
*/
3169

3270
fib <- unfold_term ["fib"] {{ fib }};
33-
print "[fib] original term:";
34-
print_term fib;
35-
fibM <- monadify_term fib;
36-
print "[fib] monadified term:";
37-
print_term fibM;
71+
fibM <- parse_core_mod "CryptolM" "\
72+
\ \\(_x : (mseq (TCNum 64) Bool)) -> \
73+
\ multiArgFixM (LRT_Fun (mseq (TCNum 64) Bool) (\\(_ : (mseq (TCNum 64) Bool)) -> LRT_Ret (mseq (TCNum 64) Bool))) \
74+
\ (\\(fib : ((mseq (TCNum 64) Bool) -> (CompM (mseq (TCNum 64) Bool)))) -> \
75+
\ \\(x : (mseq (TCNum 64) Bool)) -> \
76+
\ bindM (isFinite (TCNum 64)) (mseq (TCNum 64) Bool) (assertFiniteM (TCNum 64)) \
77+
\ (\\(x' : (isFinite (TCNum 64))) -> \
78+
\ bindM (isFinite (TCNum 64)) (mseq (TCNum 64) Bool) (assertFiniteM (TCNum 64)) \
79+
\ (\\(x'' : (isFinite (TCNum 64))) -> \
80+
\ ite (CompM (mseq (TCNum 64) Bool)) \
81+
\ (ecEq (mseq (TCNum 64) Bool) (PEqMSeqBool (TCNum 64) x') x \
82+
\ (ecNumber (TCNum 0) (mseq (TCNum 64) Bool) (PLiteralSeqBoolM (TCNum 64) x''))) \
83+
\ (bindM (isFinite (TCNum 64)) (mseq (TCNum 64) Bool) (assertFiniteM (TCNum 64)) \
84+
\ (\\(x''' : (isFinite (TCNum 64))) -> \
85+
\ returnM (mseq (TCNum 64) Bool) \
86+
\ (ecNumber (TCNum 1) (mseq (TCNum 64) Bool) \
87+
\ (PLiteralSeqBoolM (TCNum 64) x''')))) \
88+
\ (bindM (isFinite (TCNum 64)) (mseq (TCNum 64) Bool) (assertFiniteM (TCNum 64)) \
89+
\ (\\(x''' : (isFinite (TCNum 64))) -> \
90+
\ bindM (isFinite (TCNum 64)) (mseq (TCNum 64) Bool) (assertFiniteM (TCNum 64)) \
91+
\ (\\(x'''' : (isFinite (TCNum 64))) -> \
92+
\ bindM (mseq (TCNum 64) Bool) (mseq (TCNum 64) Bool) \
93+
\ (fib \
94+
\ (ecMinus (mseq (TCNum 64) Bool) (PRingMSeqBool (TCNum 64) x''') x \
95+
\ (ecNumber (TCNum 1) (mseq (TCNum 64) Bool) \
96+
\ (PLiteralSeqBoolM (TCNum 64) x'''')))) \
97+
\ (\\(x''''' : (mseq (TCNum 64) Bool)) -> \
98+
\ returnM (mseq (TCNum 64) Bool) \
99+
\ (ecMul (mseq (TCNum 64) Bool) (PRingMSeqBool (TCNum 64) x''') x \
100+
\ x''''')))))))) \
101+
\ _x";
102+
run_test "fib" fib fibM;
38103

39104
noErrors <- unfold_term ["noErrors"] {{ SpecPrims::noErrors }};
40-
print "[noErrors] original term:";
41-
print_term noErrors;
42-
noErrorsM <- monadify_term noErrors;
43-
print "[noErrors] monadified term:";
44-
print_term noErrorsM;
105+
noErrorsM <- parse_core_mod "CryptolM" "\\(a : sort 0) -> existsM a a (\\(x : a) -> returnM a x)";
106+
run_test "noErrors" noErrors noErrorsM;
45107

46108
fibSpecNoErrors <- unfold_term ["fibSpecNoErrors"] {{ fibSpecNoErrors }};
47-
print "[fibSpecNoErrors] original term:";
48-
print_term fibSpecNoErrors;
49-
fibSpecNoErrorsM <- monadify_term fibSpecNoErrors;
50-
print "[fibSpecNoErrors] monadified term:";
51-
print_term fibSpecNoErrorsM;
109+
fibSpecNoErrorsM <- parse_core_mod "CryptolM" "\
110+
\ \\(__p1 : (mseq (TCNum 64) Bool)) -> \
111+
\ existsM (mseq (TCNum 64) Bool) (mseq (TCNum 64) Bool) \
112+
\ (\\(x : (mseq (TCNum 64) Bool)) -> \
113+
\ returnM (mseq (TCNum 64) Bool) x)";
114+
run_test "fibSpecNoErrors" fibSpecNoErrors fibSpecNoErrorsM;

‎src/SAWScript/Builtins.hs

+9-7
Original file line numberDiff line numberDiff line change
@@ -323,15 +323,17 @@ hoistIfsPrim t = do
323323

324324
return t{ ttTerm = t' }
325325

326+
isConvertiblePrim :: TypedTerm -> TypedTerm -> TopLevel Bool
327+
isConvertiblePrim x y = do
328+
sc <- getSharedContext
329+
io $ scConvertible sc False (ttTerm x) (ttTerm y)
330+
326331
checkConvertiblePrim :: TypedTerm -> TypedTerm -> TopLevel ()
327332
checkConvertiblePrim x y = do
328-
sc <- getSharedContext
329-
str <- io $ do
330-
c <- scConvertible sc False (ttTerm x) (ttTerm y)
331-
pure (if c
332-
then "Convertible"
333-
else "Not convertible")
334-
printOutLnTop Info str
333+
c <- isConvertiblePrim x y
334+
printOutLnTop Info (if c
335+
then "Convertible"
336+
else "Not convertible")
335337

336338

337339
readCore :: FilePath -> TopLevel TypedTerm

‎src/SAWScript/Interpreter.hs

+6-1
Original file line numberDiff line numberDiff line change
@@ -1071,10 +1071,15 @@ primitives = Map.fromList
10711071
, "object that can be passed to 'read_sbv'."
10721072
]
10731073

1074+
, prim "is_convertible" "Term -> Term -> TopLevel Bool"
1075+
(pureVal isConvertiblePrim)
1076+
Current
1077+
[ "Returns true iff the two terms are convertible." ]
1078+
10741079
, prim "check_convertible" "Term -> Term -> TopLevel ()"
10751080
(pureVal checkConvertiblePrim)
10761081
Current
1077-
[ "Check if two terms are convertible." ]
1082+
[ "Check if two terms are convertible and print the result." ]
10781083

10791084
, prim "replace" "Term -> Term -> Term -> TopLevel Term"
10801085
(pureVal replacePrim)

0 commit comments

Comments
 (0)