Skip to content

Commit 3e1f660

Browse files
committed
add succint 'unit test-like' demonstrator
1 parent 9f97fc2 commit 3e1f660

1 file changed

Lines changed: 43 additions & 1 deletion

File tree

proofs/sudoers.mlw

Lines changed: 43 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -229,7 +229,7 @@ let get_aliases (table: seq (def 'a)) (pred: 'a -> bool): found_aliases
229229

230230
end
231231

232-
module CorrectnessProof
232+
module Expansion
233233

234234
use int.Int
235235
use option.Option
@@ -437,3 +437,45 @@ let expand_all_aliases (items: seq (spec 'tag 'a)) (table: seq (def 'a)) (ghost
437437
!cur
438438

439439
end
440+
441+
module Correctness
442+
443+
use int.Int
444+
use option.Option
445+
use seq.Seq
446+
447+
use FindItem
448+
use AliasTable
449+
use Expansion
450+
451+
let demonstration (items: seq (spec 'tag 'a)) (table: seq (def 'a)) (pred: 'a -> bool)
452+
(* make sure the keys are uniquely defined *)
453+
requires { forall i j. 0 <= i < j < length table ->
454+
let (k1, _) = table[i] in
455+
let (k2, _) = table[j] in
456+
k1 <> k2 }
457+
458+
(* require all aliases to be defined in the table *)
459+
requires { forall key.
460+
(exists i. 0 <= i < length items /\ who items[i] = Alias key) \/
461+
(exists k i. 0 <= k < length table /\ let (_, items) = table[k] in
462+
0 <= i < length items /\ who items[i] = Alias key)
463+
->
464+
exists j. 0 <= j < length table /\ let (id, _) = table[j] in id = key }
465+
466+
(* make sure the table is topologically sorted *)
467+
requires { forall i j. 0 <= i <= j < length table ->
468+
let (_, items) = table[i] in
469+
let (key, _) = table[j] in
470+
forall k. 0 <= k < length items -> who items[k] <> Alias key }
471+
472+
= let aliases = get_aliases table pred in
473+
474+
let expanded = expand_all_aliases items table (ghost pred) (ghost aliases) in
475+
476+
let a = find_item expanded pred (any found_aliases) in
477+
let b = find_item items pred aliases in
478+
479+
assert { a = b }
480+
481+
end

0 commit comments

Comments
 (0)